* Temporary directory:: Where temporary files are kept.
* Localname deconstruction:: Breaking a localname into its components.
* External packages:: Integration with external Lisp packages.
+* Extension packages:: Adding new methods to @value{tramp}.
@end detailmenu
@end menu
@command{rsync} performs much better than @command{scp} when
transferring files that exist on both hosts. However, this advantage
-is lost if the file exists only on one side of the connection.
+is lost if the file exists only on one side of the connection, during
+the first file transfer.
This method supports the @samp{-p} argument.
@c @item ibuffer-tramp.el
@c Contact Svend Sorensen <svend@@ciffer.net>
+@cindex method @option{incus}
+@cindex @option{incus} method
+@item incus-tramp
+Integration for Incus containers. A container is accessed via
+@file{@trampfn{incus,user@@container,/path/to/file}}, @samp{user} and
+@samp{container} have the same meaning as with the @option{docker}
+method.
+
@cindex method @option{lxc}
@cindex @option{lxc} method
@item lxc-tramp
@vindex auth-source-do-cache
Set @code{auth-source-do-cache} to @code{nil} to disable password caching.
+For connections which use a session-timeout, like @option{sudo},
+@option{doas} and @option{run0}, the password cache is expired by
+@value{tramp} when the session expires (@pxref{Predefined connection
+information}). However, this makes only sense if the password cannot
+be retrieved from a persistent authentication file or store.
+
@node Connection caching
@section Reusing connection related information
@item @t{"tmpdir"}
The temporary directory on the remote host. If not specified, the
-default value is @t{"/data/local/tmp"} for the @option{adb} method,
-@t{"/C$/Temp"} for the @option{smb} method, and @t{"/tmp"} otherwise.
-@ref{Temporary directory}.
+default value is @t{"/data/local/tmp"} for the @option{adb} and
+@option{androidsu} methods, @t{"/C$/Temp"} for the @option{smb}
+method, and @t{"/tmp"} otherwise. @ref{Temporary directory}.
@item @t{"posix"}
@example
@group
if test "$TERM" = "dumb"; then
- ...
+ @dots{}
fi
@end group
@end example
host names prefixed to the file name. For example, transforming
@file{/etc/secretfile} to
@file{~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile}, set the
-@value{tramp} user option @code{tramp-backup-directory-alist} from
-the existing user option @code{backup-directory-alist}.
+@value{tramp} user option @code{tramp-backup-directory-alist} from the
+existing user option @code{backup-directory-alist}.
Then @value{tramp} backs up to a file name that is transformed with a
prefix consisting of the DIRECTORY name. This file name prefixing
The backup file name of
@file{@trampfn{su,root@@localhost,/etc/secretfile}} would be
@ifset unified
-@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/!su:root@@localhost:!etc!secretfile~}}.
+@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/@c
+!su:root@@localhost:!etc!secretfile~}}.
@end ifset
@ifset separate
-@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/![su!root@@localhost]!etc!secretfile~}}.
+@file{@trampfn{su,root@@localhost,~/.emacs.d/backups/@c
+![su!root@@localhost]!etc!secretfile~}}.
@end ifset
@vindex auto-save-file-name-transforms
Each involved method must be an inline method (@pxref{Inline methods}).
-@value{tramp} adds the ad-hoc definitions on the fly to
-@code{tramp-default-proxies-alist} and is available for reuse during
-that Emacs session. Subsequent @value{tramp} connections to the same
-remote host can then use the shortcut form:
-@samp{@trampfn{ssh,you@@remotehost,/path}}.
+@value{tramp} adds the ad-hoc definitions as an ephemeral record to
+@code{tramp-default-proxies-alist}, which are available for reuse
+during that Emacs session. Subsequent @value{tramp} connections to
+the same remote host can then use the abbreviated form
+@file{@trampfn{ssh,you@@remotehost,/path}}.
+@anchor{tramp-show-ad-hoc-proxies}
@defopt tramp-show-ad-hoc-proxies
If this user option is non-@code{nil}, ad-hoc definitions are kept in
-remote file names instead of showing the shortcuts.
+remote file names instead of showing the abbreviations. This is
+useful if the ad-hoc proxy definition shall be used in further Emacs
+sessions, kept in configuration files of recentf and other packages.
+
+A non-@code{nil} setting of this option has effect only if set before
+the connection is established.
@lisp
(customize-set-variable 'tramp-show-ad-hoc-proxies t)
via the command @kbd{M-x tramp-cleanup-all-connections @key{RET}}
(@pxref{Cleanup remote connections}).
+@anchor{tramp-save-ad-hoc-proxies}
@defopt tramp-save-ad-hoc-proxies
For ad-hoc definitions to be saved automatically in
@code{tramp-default-proxies-alist} for future Emacs sessions, set
-@code{tramp-save-ad-hoc-proxies} to non-@code{nil}.
+@code{tramp-save-ad-hoc-proxies} to non-@code{nil}. The resulting
+user option @code{tramp-default-proxies-alist} is saved in your
+@file{.emacs} file.
+
+If you use saved configuration files with abbreviated ad-hoc proxy
+definitions on another host, for example by distribution of the
+@code{recentf-save-file}, you must distribute your @file{.emacs} file
+as well.
@lisp
(customize-set-variable 'tramp-save-ad-hoc-proxies t)
It does not report the remote terminal name via @code{process-tty-name}.
@item
-It does not set process property @code{remote-pid}.
+It does not set process property @code{remote-pid}. Consequently,
+signals cannot be sent to that remote process; they are sent to the
+local process instead, which establishes the connection.
@item
It fails, when the command is too long. This can happen on
supported but deprecated, and it will be removed in a future
@value{tramp} version.
+@strong{Note}: For the @option{ssh} and @option{scp} methods,
+@value{tramp} does not faithfully pass binary sequences on to the
+process. You can change this by changing the respective connection
+argument (@pxref{Predefined connection information}) via
+
+@lisp
+(add-to-list 'tramp-connection-properties (list "/ssh:" "direct-async" t))
+@end lisp
+
@node Cleanup remote connections
@section Cleanup remote connections
Since all file operations are mapped internally to @acronym{GVFS}
operations, remote file names supported by @code{tramp-gvfs} perform
better, because no local copy of the file archive must be downloaded
-first. For example, @samp{/sftp:user@@host:...} performs better than
-the similar @samp{/scp:user@@host:...}. See the constant
+first. For example, @samp{/sftp:user@@host:@dots{}} performs better
+than the similar @samp{/scp:user@@host:@dots{}}. See the constant
@code{tramp-archive-all-gvfs-methods} for a complete list of
@code{tramp-gvfs} supported method names.
contents of files and directories will be included in the debug buffer.
Passwords typed in @value{tramp} will never be included there.
+If you find, that using @value{tramp} with @command{emacs -Q} doesn't
+cause any problem, you might check your init file for the suspicious
+configuration by bisecting it. That is, comment out about half of the
+init file, and check whether the problem still arises when calling
+@command{emacs}. If yes, comment out half of the still active code.
+Otherwise, comment out the active code, and uncomment the just
+commented code.
+
+Call @command{emacs}, again. Reiterate, until you find the suspicious
+configuration.
+
@node Frequently Asked Questions
@chapter Frequently Asked Questions
(residential) keys by @command{ssh-agent}. As workaround, you might
disable @command{ssh-agent} for such keys.
+
+@item
+Does @value{tramp} support fingerprint readers?
+
+Yes. A fingerprint reader can be used as an additional authentication
+method for @option{sudo}-based logins. @value{tramp} supports the
+required additional handshaking messages@footnote{It supports
+fingerprint readers driven by @command{fprintd}.}. If the fingerprint
+isn't recognized by the fingerprint reader in time, authentication
+falls back to requesting a password.
+
+@vindex tramp-use-fingerprint
+If the user option @code{tramp-use-fingerprint} is @code{nil},
+@value{tramp} interrupts the fingerprint request, falling back to
+password authentication immediately.
+
+
@item
@value{tramp} does not connect to Samba or MS Windows hosts running
SMB1 connection protocol
@end group
@end lisp
+@vindex XDG_DATA_HOME@r{, environment variable}
If Emacs is configured to use the XDG conventions for the trash
directory, remote files cannot be restored with the respective tools,
because those conventions don't specify remote paths. Such files must
@item
-Why saved multi-hop file names do not work in a new Emacs session?
+Why don't saved ad-hoc multi-hop file names work in a new Emacs session?
+
+By default, ad-hoc multi-hop file names are abbreviated after
+completing the initial connection. These abbreviated forms retain
+only the final hop, and so only the Emacs session that generated the
+abbreviated form can understand it. @xref{Ad-hoc multi-hops}.
-When saving ad-hoc multi-hop @value{tramp} file names (@pxref{Ad-hoc
-multi-hops}) via bookmarks, recent files, filecache, bbdb, or another
-package, use the full ad-hoc file name including all hops, like
-@file{@trampfn{ssh,bird@@bastion|ssh@value{postfixhop}@c
-news.my.domain,/opt/news/etc}}.
+For example, after connecting to @file{@trampfn{ssh,bird@@bastion|@c
+ssh@value{postfixhop}news@@news.my.domain,/opt/news/etc}}, the file
+name becomes @file{@trampfn{ssh,news@@news.my.domain,/opt/news/etc}}.
+If the abbreviated form is saved in a bookmark, the recent files list,
+bbdb, or similar, a new Emacs session has no way to know that the
+connection must go through @samp{bird@@bastion} first.
-Alternatively, when saving abbreviated multi-hop file names
-@file{@trampfn{ssh,news@@news.my.domain,/opt/news/etc}}, the user
-option @code{tramp-save-ad-hoc-proxies} must be set non-@code{nil}
-value.
+There are two mechanisms to deal with this. The first is to customize
+@code{tramp-show-ad-hoc-proxies} to a non-@code{nil} value, which
+disables abbreviation. Then the fully-qualified ad-hoc multi-hop file
+name is the one that will be both displayed and saved.
+@xref{tramp-show-ad-hoc-proxies}.
+
+Alternatively, you can customize @code{tramp-save-ad-hoc-proxies} to a
+non-@code{nil} value which means to save the information how an
+abbreviated multi-hop file name can be expanded.
+@xref{tramp-save-ad-hoc-proxies}.
@item
@item
How to determine whether a buffer is remote?
+@findex file-remote-p
+@vindex default-directory
The buffer-local variable @code{default-directory} tells this. If the
form @code{(file-remote-p default-directory)} returns non-@code{nil},
the buffer is remote. See the optional arguments of
@end lisp
+@item
+I get an error @samp{unix_listener: path
+"/very/long/path/.cache/emacs/tramp.XXX" too long for Unix domain
+socket} when connecting via @option{ssh} to a remote host.
+
+@vindex small-temporary-file-directory
+By default, @value{tramp} uses the directory @file{~/.cache/emacs/}
+for creation of OpenSSH Unix domain sockets. On GNU/Linux, domain
+sockets have a much lower maximum path length (currently 107
+characters) than normal files.
+
+You can change this directory by setting the user option
+@code{small-temporary-file-directory} to another name, like
+
+@lisp
+@group
+(unless small-temporary-file-directory
+ (customize-set-variable
+ 'small-temporary-file-directory
+ (format "/run/user/%d/emacs/" (user-uid)))
+ (make-directory small-temporary-file-directory t))
+@end group
+@end lisp
+
+@vindex XDG_RUNTIME_DIR@r{, environment variable}
+@t{"/run/user/UID"} is the value of the environment variable
+@env{XDG_RUNTIME_DIR}, which you can use instead via @code{(getenv
+"XDG_RUNTIME_DIR")}.
+
+
@item
How to ignore errors when changing file attributes?
* Temporary directory:: Where temporary files are kept.
* Localname deconstruction:: Splitting a localname into its component parts.
* External packages:: Integrating with external Lisp packages.
+* Extension packages:: Adding new methods to @value{tramp}.
@end menu
@code{default-directory} of the process buffer as the root directory.
-@subsection Timers
+@subsection Timers, process filters, process sentinels, redisplay
@vindex remote-file-error
Timers run asynchronously at any time when Emacs is waiting for
@end group
@end lisp
+A similar problem could happen with process filters, process
+sentinels, and redisplay (updating the mode line).
+
+
+@node Extension packages
+@section Adding new methods to @value{tramp}
+
+There are two ways to add new methods to @value{tramp}: writing a new
+backend including an own file name handler, or adding the new method,
+using the existing @code{tramp-sh-file-name-handler}. The former
+shall happen inside the @value{tramp} repository, and it isn't
+discussed here. The latter means usually a new ELPA package.
+@pxref{Customizing Methods} for some examples.
+
+
+@subsection Writing an own ELPA package
+
+An external ELPA package @file{foo-tramp.el}, which intends to
+provide a new @value{tramp} method, say @option{foo}, must add this
+new method to the variable @code{tramp-methods}. This variable is an
+alist with elements @code{(@var{name} @var{param1} @var{param2}
+@dots{})}.
+
+@var{name} is the method name, @t{"foo"} in this case.
+@var{param}@t{x} is a pair of the form @code{(@var{key} @var{value})}.
+See the docstring of variable @code{tramp-methods} for possible
+@var{key}s and @var{value}s. An example would be
+
+@lisp
+@group
+(add-to-list
+ 'tramp-methods
+ `("foo"
+ (tramp-login-program ,foo-tramp-executable)
+ (tramp-login-args (("exec") ("%h") ("--") ("su - %u")))
+ (tramp-remote-shell "/bin/sh")
+ (tramp-remote-shell-args ("-i" "-c"))))
+@end group
+@end lisp
+
+@code{foo-tramp-executable} in this example would be a Lisp constant,
+which is the program name of @command{foo}.
+
+Another initialization could tell @value{tramp} which are the default
+user and host name for method @option{foo}. This is done by calling
+@code{tramp-set-completion-function}:
+
+@lisp
+@group
+(tramp-set-completion-function
+ "foo"
+ '((tramp-foo--completion-function @var{arg})))
+@end group
+@end lisp
+
+@code{tramp-foo--completion-function} is a function, which returns
+completion candidates. @var{arg}, a string, is the argument for the
+completion function, for example a file name to read from.
+@pxref{Customizing Completion} for details.
+
+Finally, it might also be helpful to define default user or host names
+for method @option{foo}, in case a remote file name leaves them empty.
+This can be performed by calling
+
+@lisp
+@group
+(add-to-list 'tramp-default-user-alist '("foo" nil "root"))
+(add-to-list 'tramp-default-host-alist '("foo" nil "localhost"))
+@end group
+@end lisp
+
+@pxref{Default User} and @ref{Default Host} explaining the user options
+@code{tramp-default-user-alist} and @code{tramp-default-host-alist}.
+
+
+@subsection Making a customized method optional
+
+The settings of the previous subsection are global in the package
+@file{foo-tramp.el}, meaning they are activated when loading
+@code{foo-tramp}. Sometimes, it is desired to make these settings
+available without loading the whole package @code{foo-tramp}, but
+declaring the new method @option{foo} as optional method only. In
+this case, declare a function @code{tramp-enable-foo-method} which
+collects the initialization. This function must be auto loaded.
+
+@lisp
+@group
+;;;###autoload
+(defun tramp-enable-foo-method ()
+ (add-to-list 'tramp-methods '("foo" @dots{}))
+ (tramp-set-completion-function "foo" @dots{})
+ (add-to-list 'tramp-default-user-alist '("foo" @dots{}))
+ (add-to-list 'tramp-default-host-alist '("foo" @dots{})))
+@end group
+@end lisp
+
+Then, you can activate method @option{foo} by calling @kbd{M-x
+tramp-enable-method @key{RET} foo @key{RET}}. @pxref{Optional methods}.
+
+
+@subsection Activating a customized method without loading the package
+
+If you want to make method @option{foo} known after loading
+@value{tramp}, without loading the package @file{foo-tramp.el}, you
+must autoload the implementation of function
+@code{tramp-enable-foo-method}. Add the following code in
+@file{foo-tramp.el}:
+
+@lisp
+@group
+;;;###autoload
+(progn
+ (defun tramp-enable-foo-method ()
+ (add-to-list 'tramp-methods '("foo" @dots{}))
+ (tramp-set-completion-function "foo" @dots{})
+ (add-to-list 'tramp-default-user-alist '("foo" @dots{}))
+ (add-to-list 'tramp-default-host-alist '("foo" @dots{}))))
+
+;;;###autoload
+(with-eval-after-load 'tramp (tramp-enable-method "foo"))
+@end group
+@end lisp
+
+The trick is to wrap the function definition of
+@code{tramp-enable-foo-method} with @code{progn} for the
+@code{;;;###autoload} cookie.
+
@node Traces and Profiles
@chapter How to Customize Traces
@c In the Tramp GIT, the version number and the bug report address
@c are auto-frobbed from configure.ac.
-@set trampver 2.7.1.30.1
+@set trampver 2.7.3-pre
@set trampurl https://www.gnu.org/software/tramp/
@set tramp-bug-report-address tramp-devel@@gnu.org
@set emacsver 27.1
;;;###tramp-autoload
(defsubst tramp-adb-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for ADB."
- (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
- (string= (tramp-file-name-method vec) tramp-adb-method)))
+ (and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
+ ((string= (tramp-file-name-method vec) tramp-adb-method)))))
;;;###tramp-autoload
(defun tramp-adb-file-name-handler (operation &rest args)
"Invoke the ADB handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
- (if-let ((fn (assoc operation tramp-adb-file-name-handler-alist)))
+ (if-let* ((fn (assoc operation tramp-adb-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
(tramp-shell-quote-argument l2))
"Error copying %s to %s" filename newname))
- (if-let ((tmpfile (file-local-copy filename)))
+ (if-let* ((tmpfile (file-local-copy filename)))
;; Remote filename.
(condition-case err
(rename-file tmpfile newname ok-if-already-exists)
;; <https://android.stackexchange.com/questions/226638/how-to-use-multibyte-file-names-in-adb-shell/232379#232379>
;; mksh uses UTF-8 internally, but is currently limited to the
;; BMP (basic multilingua plane), which means U+0000 to
- ;; U+FFFD. If you want to use SMP codepoints (U-00010000 to
+ ;; U+FFFD. If you want to use SMP codepoints (U-00010000 to
;; U-0010FFFD) on the input line, you currently have to disable
;; the UTF-8 mode (sorry).
(tramp-adb-execute-adb-command vec "shell" command)
tramp-adb-program args)))
(prompt (md5 (concat (prin1-to-string process-environment)
(current-time-string)))))
+
+ ;; Set sentinel. Initialize variables.
+ (set-process-sentinel p #'tramp-process-sentinel)
+ (tramp-post-process-creation p vec)
+
;; Wait for initial prompt. On some devices, it needs
;; an initial RET, in order to get it.
(sleep-for 0.1)
(unless (process-live-p p)
(tramp-error vec 'file-error "Terminated!"))
- ;; Set sentinel. Initialize variables.
- (set-process-sentinel p #'tramp-process-sentinel)
- (tramp-post-process-creation p vec)
-
;; Set connection-local variables.
(tramp-set-connection-local-variables vec)
;;;###tramp-autoload
(defsubst tramp-androidsu-file-name-p (vec-or-filename)
"Check whether VEC-OR-FILENAME is for the `androidsu' method."
- (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
- (equal (tramp-file-name-method vec) tramp-androidsu-method)))
+ (and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
+ ((equal (tramp-file-name-method vec) tramp-androidsu-method)))))
;;;###tramp-autoload
(defun tramp-androidsu-file-name-handler (operation &rest args)
"Invoke the `androidsu' handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
- (if-let ((fn (assoc operation tramp-androidsu-file-name-handler-alist)))
+ (if-let* ((fn (assoc operation tramp-androidsu-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
\f
;; File name conversions.
+;;;###tramp-autoload
(defun tramp-archive-file-name-p (name)
"Return t if NAME is a string with archive file name syntax."
(and (stringp name)
"Return NAME in GVFS syntax."
(tramp-make-tramp-file-name (tramp-archive-dissect-file-name name)))
+;; This is used in GNU ELPA package tramp-locproc.el.
+(defun tramp-archive-local-file-name (filename)
+ "Return local mount name of FILENAME."
+ (let ((tramp-methods (cons `(,tramp-archive-method) tramp-methods)))
+ (tramp-gvfs-local-file-name (tramp-archive-gvfs-file-name filename))))
+
\f
;; File name primitives.
;; Some properties are handled special:
;;
-;; - "process-name", "process-buffer" and "first-password-request" are
-;; not saved in the file `tramp-persistency-file-name', although
-;; being connection properties related to a `tramp-file-name'
-;; structure.
+;; - "process-name", "process-buffer", "first-password-request" and
+;; "pw-spec" are not saved in the file
+;; `tramp-persistency-file-name', although being connection
+;; properties related to a `tramp-file-name' structure.
;;
;; - Reusable properties, which should not be saved, are kept in the
;; process key retrieved by `tramp-get-process' (the main connection
Every entry has the form (REGEXP PROPERTY VALUE). The regexp
matches remote file names. It can be nil. PROPERTY is a string,
and VALUE the corresponding value. They are used, if there is no
-matching entry for PROPERTY in `tramp-cache-data'. For more
-details see the info pages."
+matching entry for PROPERTY in `tramp-cache-data'.
+
+PROPERTY can also be a string representing a parameter in
+`tramp-methods'. For more details see the Info node `(tramp) Predefined
+connection information'."
:group 'tramp
:version "24.4"
:type '(repeat (list (choice :tag "File Name regexp" regexp (const nil))
"Remove some properties of FILE's upper directory."
(when (file-name-absolute-p file)
;; `file-name-directory' can return nil, for example for "~".
- (when-let ((file (file-name-directory file))
- (file (directory-file-name file)))
+ (when-let* ((file (file-name-directory file))
+ (file (directory-file-name file)))
(setq key (tramp-file-name-unify key file))
(unless (eq key tramp-cache-undefined)
(dolist (property (hash-table-keys (tramp-get-hash-table key)))
(not (and (processp key) (not (process-live-p key)))))
(setq value cached
cache-used t))
- (tramp-message key 7 "%s %s; cache used: %s" property value cache-used)
+ (unless (eq key tramp-cache-version)
+ (tramp-message key 7 "%s %s; cache used: %s" property value cache-used))
value))
;;;###tramp-autoload
PROPERTY is set persistent when KEY is a `tramp-file-name' structure.
Return VALUE."
(setq key (tramp-file-name-unify key))
- (when-let ((hash (tramp-get-hash-table key)))
+ (when-let* ((hash (tramp-get-hash-table key)))
(puthash property value hash))
(setq tramp-cache-data-changed
(or tramp-cache-data-changed (tramp-file-name-p key)))
- (tramp-message key 7 "%s %s" property value)
+ (unless (eq key tramp-cache-version)
+ (tramp-message key 7 "%s %s" property value))
value)
;;;###tramp-autoload
used to cache connection properties of the local machine.
PROPERTY is set persistent when KEY is a `tramp-file-name' structure."
(setq key (tramp-file-name-unify key))
- (when-let ((hash (tramp-get-hash-table key)))
+ (when-let* ((hash (tramp-get-hash-table key)))
(remhash property hash))
(setq tramp-cache-data-changed
(or tramp-cache-data-changed (tramp-file-name-p key)))
(setq key (tramp-file-name-unify key))
(tramp-message
key 7 "%s %s" key
- (when-let ((hash (gethash key tramp-cache-data)))
+ (when-let* ((hash (gethash key tramp-cache-data)))
(hash-table-keys hash)))
(setq tramp-cache-data-changed
(or tramp-cache-data-changed (tramp-file-name-p key)))
(hash (tramp-get-hash-table key))
(cached (and (hash-table-p hash)
(gethash ,property hash tramp-cache-undefined))))
+ (tramp-message key 7 "Saved %s %s" property cached)
(unwind-protect (progn ,@body)
;; Reset PROPERTY. Recompute hash, it could have been flushed.
+ (tramp-message key 7 "Restored %s %s" property cached)
(setq hash (tramp-get-hash-table key))
(if (not (eq cached tramp-cache-undefined))
(puthash ,property cached hash)
(mapcar
(lambda (property)
(cons property (gethash property hash tramp-cache-undefined)))
- ,properties)))
+ ,properties))
+ ;; Avoid superfluous debug buffers during host name completion.
+ (tramp-verbose (if minibuffer-completing-file-name 0 tramp-verbose)))
+ (tramp-message key 7 "Saved %s" values)
(unwind-protect (progn ,@body)
;; Reset PROPERTIES. Recompute hash, it could have been flushed.
+ (tramp-message key 7 "Restored %s" values)
(setq hash (tramp-get-hash-table key))
(dolist (value values)
(if (not (eq (cdr value) tramp-cache-undefined))
(progn
(remhash "process-name" value)
(remhash "process-buffer" value)
- (remhash "first-password-request" value))
+ (remhash "first-password-request" value)
+ (remhash "pw-spec" value))
(remhash key cache)))
cache)
;; Dump it.
(defvar mm-7bit-chars)
(defvar reporter-eval-buffer)
(defvar reporter-prompt-for-summary-p)
+(defvar tramp-repository-branch)
+(defvar tramp-repository-version)
;;;###tramp-autoload
(defun tramp-change-syntax (&optional syntax)
(interactive)
(cond
((buffer-file-name)
- (find-alternate-file (tramp-file-name-with-sudo (buffer-file-name))))
+ (let ((pos (point)))
+ (find-alternate-file (tramp-file-name-with-sudo (buffer-file-name)))
+ (goto-char pos)))
((tramp-dired-buffer-p)
(dired-unadvertise (expand-file-name default-directory))
(setq default-directory (tramp-file-name-with-sudo default-directory)
;; (declare (completion tramp-recompile-elpa-command-completion-p))
(interactive)
;; We expect just one Tramp package is installed.
- (when-let
+ (when-let*
((dir (tramp-compat-funcall
'package-desc-dir
(car (alist-get 'tramp (bound-and-true-p package-alist))))))
(defun tramp-reporter-dump-variable (varsym mailbuf)
"Pretty-print the value of the variable in symbol VARSYM."
- (when-let ((reporter-eval-buffer reporter-eval-buffer)
- (val (buffer-local-value varsym reporter-eval-buffer)))
+ (when-let* ((reporter-eval-buffer reporter-eval-buffer)
+ (val (buffer-local-value varsym reporter-eval-buffer)))
(if (hash-table-p val)
;; Pretty print the cache.
;; an infloop. We try to follow the XDG specification, for security reasons.
(defconst tramp-compat-temporary-file-directory
(file-name-as-directory
- (if-let ((xdg (xdg-cache-home))
- ((file-directory-p xdg))
- ((file-writable-p xdg)))
- ;; We can use `file-name-concat' starting with Emacs 28.1.
- (prog1 (setq xdg (concat (file-name-as-directory xdg) "emacs"))
+ (if-let* ((xdg (xdg-cache-home))
+ ((file-directory-p xdg))
+ ((file-writable-p xdg)))
+ (prog1 (setq xdg (expand-file-name "emacs" xdg))
(make-directory xdg t))
(eval (car (get 'temporary-file-directory 'standard-value)) t)))
"The default value of `temporary-file-directory' for Tramp.")
(if (not criteria)
,variable
(hack-connection-local-variables criteria)
- (if-let ((result (assq ',variable connection-local-variables-alist)))
+ (if-let* ((result (assq ',variable connection-local-variables-alist)))
(cdr result)
,variable)))))
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
- (when-let ((raw-list
- (shell-command-to-string
- (concat program " ps --format '{{.ID}}\t{{.Names}}'")))
- (lines (split-string raw-list "\n" 'omit))
- (names
- (tramp-compat-seq-keep
- (lambda (line)
- (when (string-match
- (rx bol (group (1+ nonl))
- "\t" (? (group (1+ nonl))) eol)
- line)
- (or (match-string 2 line) (match-string 1 line))))
- lines)))
+ (when-let* ((raw-list
+ (shell-command-to-string
+ (concat program " ps --format '{{.ID}}\t{{.Names}}'")))
+ (lines (split-string raw-list "\n" 'omit))
+ (names
+ (tramp-compat-seq-keep
+ (lambda (line)
+ (when (string-match
+ (rx bol (group (1+ nonl))
+ "\t" (? (group (1+ nonl))) eol)
+ line)
+ (or (match-string 2 line) (match-string 1 line))))
+ lines)))
(mapcar (lambda (name) (list nil name)) names))))
;;;###tramp-autoload
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
- (when-let ((raw-list
- (shell-command-to-string
- (concat
- program " "
- (tramp-kubernetes--context-namespace vec)
- " get pods --no-headers"
- ;; We separate pods by "|". Inside a pod, its name
- ;; is separated from the containers by ":".
- ;; Containers are separated by ",".
- " -o jsonpath='{range .items[*]}{\"|\"}{.metadata.name}"
- "{\":\"}{range .spec.containers[*]}{.name}{\",\"}"
- "{end}{end}'")))
- (lines (split-string raw-list "|" 'omit)))
+ (when-let* ((raw-list
+ (shell-command-to-string
+ (concat
+ program " "
+ (tramp-kubernetes--context-namespace vec)
+ " get pods --no-headers"
+ ;; We separate pods by "|". Inside a pod, its name
+ ;; is separated from the containers by ":".
+ ;; Containers are separated by ",".
+ " -o jsonpath='{range .items[*]}{\"|\"}{.metadata.name}"
+ "{\":\"}{range .spec.containers[*]}{.name}{\",\"}"
+ "{end}{end}'")))
+ (lines (split-string raw-list "|" 'omit)))
(let (names)
(dolist (line lines)
(setq line (split-string line ":" 'omit))
(defun tramp-kubernetes--current-context-data (vec)
"Return Kubernetes current context data as JSON string."
- (when-let ((current-context (tramp-kubernetes--current-context vec)))
+ (when-let* ((current-context (tramp-kubernetes--current-context vec)))
(tramp-skeleton-kubernetes-vector vec
(with-temp-buffer
(when (zerop
"The kubectl options for context and namespace as string."
(mapconcat
#'identity
- `(,(when-let ((context (tramp-kubernetes--current-context vec)))
+ `(,(when-let* ((context (tramp-kubernetes--current-context vec)))
(format "--context=%s" context))
,(when tramp-kubernetes-namespace
(format "--namespace=%s" tramp-kubernetes-namespace)))
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
- (when-let ((raw-list (shell-command-to-string (concat program " list -c")))
- ;; Ignore header line.
- (lines (cdr (split-string raw-list "\n" 'omit)))
- ;; We do not show container IDs.
- (names (tramp-compat-seq-keep
- (lambda (line)
- (when (string-match
- (rx bol (1+ (not space))
- (1+ space) (group (1+ (not space))) space)
- line)
- (match-string 1 line)))
- lines)))
+ (when-let* ((raw-list (shell-command-to-string (concat program " list -c")))
+ ;; Ignore header line.
+ (lines (cdr (split-string raw-list "\n" 'omit)))
+ ;; We do not show container IDs.
+ (names (tramp-compat-seq-keep
+ (lambda (line)
+ (when (string-match
+ (rx bol (1+ (not space))
+ (1+ space) (group (1+ (not space))) space)
+ line)
+ (match-string 1 line)))
+ lines)))
(mapcar (lambda (name) (list nil name)) names))))
;;;###tramp-autoload
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
- (when-let ((raw-list (shell-command-to-string (concat program " list")))
- ;; Ignore header line.
- (lines (cdr (split-string raw-list "\n" 'omit)))
- ;; We do not show container IDs.
- (names (tramp-compat-seq-keep
- (lambda (line)
- (when (string-match
- (rx bol (1+ (not space))
- (1+ space) "|" (1+ space)
- (group (1+ (not space))) space)
- line)
- (match-string 1 line)))
- lines)))
+ (when-let* ((raw-list (shell-command-to-string (concat program " list")))
+ ;; Ignore header line.
+ (lines (cdr (split-string raw-list "\n" 'omit)))
+ ;; We do not show container IDs.
+ (names (tramp-compat-seq-keep
+ (lambda (line)
+ (when (string-match
+ (rx bol (1+ (not space))
+ (1+ space) "|" (1+ space)
+ (group (1+ (not space))) space)
+ line)
+ (match-string 1 line)))
+ lines)))
(mapcar (lambda (name) (list nil name)) names))))
;;;###tramp-autoload
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
- (when-let ((raw-list
- (shell-command-to-string
- ;; Ignore header line.
- (concat program " ps --columns=instance,application | cat -")))
- (lines (split-string raw-list "\n" 'omit))
- (names (tramp-compat-seq-keep
- (lambda (line)
- (when (string-match
- (rx bol (* space) (group (+ (not space)))
- (? (+ space) (group (+ (not space)))) eol)
- line)
- (or (match-string 2 line) (match-string 1 line))))
- lines)))
+ (when-let* ((raw-list
+ (shell-command-to-string
+ ;; Ignore header line.
+ (concat program " ps --columns=instance,application | cat -")))
+ (lines (split-string raw-list "\n" 'omit))
+ (names (tramp-compat-seq-keep
+ (lambda (line)
+ (when (string-match
+ (rx bol (* space) (group (+ (not space)))
+ (? (+ space) (group (+ (not space)))) eol)
+ line)
+ (or (match-string 2 line) (match-string 1 line))))
+ lines)))
(mapcar (lambda (name) (list nil name)) names))))
;;;###tramp-autoload
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
- (when-let ((raw-list
- (shell-command-to-string (concat program " instance list")))
- ;; Ignore header line.
- (lines (cdr (split-string raw-list "\n" 'omit)))
- (names (tramp-compat-seq-keep
- (lambda (line)
- (when (string-match
- (rx bol (group (1+ (not space)))
- (1+ space) (1+ (not space))
- (1+ space) (1+ (not space)))
- line)
- (match-string 1 line)))
- lines)))
+ (when-let* ((raw-list
+ (shell-command-to-string (concat program " instance list")))
+ ;; Ignore header line.
+ (lines (cdr (split-string raw-list "\n" 'omit)))
+ (names (tramp-compat-seq-keep
+ (lambda (line)
+ (when (string-match
+ (rx bol (group (1+ (not space)))
+ (1+ space) (1+ (not space))
+ (1+ space) (1+ (not space)))
+ line)
+ (match-string 1 line)))
+ lines)))
(mapcar (lambda (name) (list nil name)) names))))
(defun tramp-nspawn--completion-function (method)
This function is used by `tramp-set-completion-function', please
see its function help for a description of the format."
(tramp-skeleton-completion-function method
- (when-let ((raw-list
- (shell-command-to-string (concat program " list --all -q")))
- ;; Ignore header line.
- (lines (cdr (split-string raw-list "\n")))
- (first-words (mapcar (lambda (line) (car (split-string line)))
- lines))
- (machines (seq-take-while (lambda (name) name) first-words)))
+ (when-let* ((raw-list
+ (shell-command-to-string (concat program " list --all -q")))
+ ;; Ignore header line.
+ (lines (cdr (split-string raw-list "\n")))
+ (first-words
+ (mapcar (lambda (line) (car (split-string line))) lines))
+ (machines (seq-take-while (lambda (name) name) first-words)))
(mapcar (lambda (m) (list nil m)) machines))))
;;;###tramp-autoload
"Invoke the encrypted remote file related OPERATION.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
- (if-let ((filename
- (apply #'tramp-crypt-file-name-for-operation operation args))
- (fn (and (tramp-crypt-file-name-p filename)
- (assoc operation tramp-crypt-file-name-handler-alist))))
+ (if-let* ((filename
+ (apply #'tramp-crypt-file-name-for-operation operation args))
+ ((tramp-crypt-file-name-p filename))
+ (fn (assoc operation tramp-crypt-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-crypt-run-real-handler operation args)
"Return encrypted / decrypted NAME if NAME belongs to an encrypted directory.
OP must be `encrypt' or `decrypt'. Raise an error if this fails.
Otherwise, return NAME."
- (if-let ((tramp-crypt-enabled t)
- (dir (tramp-crypt-file-name-p name))
- ;; It must be absolute for the cache.
- (localname (substring name (1- (length dir))))
- (crypt-vec (tramp-crypt-dissect-file-name dir)))
+ (if-let* ((tramp-crypt-enabled t)
+ (dir (tramp-crypt-file-name-p name))
+ ;; It must be absolute for the cache.
+ (localname (substring name (1- (length dir))))
+ (crypt-vec (tramp-crypt-dissect-file-name dir)))
;; Preserve trailing "/".
(funcall
(if (directory-name-p name) #'file-name-as-directory #'identity)
Both files must be local files. OP must be `encrypt' or `decrypt'.
If OP is `decrypt', the basename of INFILE must be an encrypted file name.
Raise an error if this fails."
- (when-let ((tramp-crypt-enabled t)
- (dir (tramp-crypt-file-name-p root))
- (crypt-vec (tramp-crypt-dissect-file-name dir)))
+ (when-let* ((tramp-crypt-enabled t)
+ (dir (tramp-crypt-file-name-p root))
+ (crypt-vec (tramp-crypt-dissect-file-name dir)))
(let ((coding-system-for-read
(if (eq op 'decrypt) 'binary coding-system-for-read))
(coding-system-for-write
local user name, the hexlified directory NAME as host, and the
localname."
(save-match-data
- (if-let ((dir (tramp-crypt-file-name-p name)))
+ (if-let* ((dir (tramp-crypt-file-name-p name)))
(make-tramp-file-name
:method tramp-crypt-method :user (user-login-name)
:host (url-hexify-string dir))
;;;###tramp-autoload
(defsubst tramp-ftp-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME that should be forwarded to Ange-FTP."
- (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
- (string= (tramp-file-name-method vec) tramp-ftp-method)))
+ (and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
+ ((string= (tramp-file-name-method vec) tramp-ftp-method)))))
;;;###tramp-autoload
(tramp--with-startup
(defun tramp-fuse-mount-spec (vec)
"Return local mount spec of VEC."
- (if-let ((host (tramp-file-name-host vec))
- (user (tramp-file-name-user vec)))
+ (if-let* ((host (tramp-file-name-host vec))
+ (user (tramp-file-name-user vec)))
(format "%s@%s:/" user host)
(format "%s:/" host)))
;;;###tramp-autoload
(defsubst tramp-gvfs-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME handled by the GVFS daemon."
- (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
- (let ((method (tramp-file-name-method vec)))
- (and (stringp method) (member method tramp-gvfs-methods)))))
+ (and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
+ (method (tramp-file-name-method vec))
+ ((member method tramp-gvfs-methods)))))
;;;###tramp-autoload
(defun tramp-gvfs-file-name-handler (operation &rest args)
;; `file-remote-p' must not return an error. (Bug#68976)
(unless (or tramp-gvfs-enabled (eq operation 'file-remote-p))
(tramp-user-error nil "Package `tramp-gvfs' not supported"))
- (if-let ((filename (apply #'tramp-file-name-for-operation operation args))
- (tramp-gvfs-dbus-event-vector
- (and (tramp-tramp-file-p filename)
- (tramp-dissect-file-name filename)))
- (fn (assoc operation tramp-gvfs-file-name-handler-alist)))
+ (if-let* ((filename (apply #'tramp-file-name-for-operation operation args))
+ (tramp-gvfs-dbus-event-vector
+ (and (tramp-tramp-file-p filename)
+ (tramp-dissect-file-name filename)))
+ (fn (assoc operation tramp-gvfs-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
"Like `dbus-byte-array-to-string' but remove trailing \\0 if exists.
Return nil for null BYTE-ARRAY."
;; The byte array could be a variant. Take care.
- (when-let ((byte-array
- (if (and (consp byte-array) (atom (car byte-array)))
- byte-array (car byte-array))))
+ (when-let* ((byte-array
+ (if (and (consp byte-array) (atom (car byte-array)))
+ byte-array (car byte-array))))
(dbus-byte-array-to-string
(if (and (consp byte-array) (zerop (car (last byte-array))))
(butlast byte-array) byte-array))))
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
- (setq filename (file-truename filename))
+ ;; We cannot use `file-truename', this would fail for symlinks with
+ ;; non-existing target.
+ (setq filename (expand-file-name filename))
(if (file-directory-p filename)
(progn
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
+ (if (file-symlink-p filename)
+ (progn
+ (make-symbolic-link
+ (file-symlink-p filename) newname ok-if-already-exists)
+ (when (eq op 'rename) (delete-file filename)))
+
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (equal-remote (tramp-equal-remote filename newname))
+ (volatile
+ (and (eq op 'rename) (tramp-gvfs-file-name-p filename)
+ (equal
+ (cdr
+ (assoc
+ "standard::is-volatile"
+ (tramp-gvfs-get-file-attributes filename)))
+ "TRUE")))
+ ;; "gvfs-rename" is not trustworthy.
+ (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+ (when (file-regular-p newname)
+ (delete-file newname))
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (equal-remote (tramp-equal-remote filename newname))
- (volatile
- (and (eq op 'rename) (tramp-gvfs-file-name-p filename)
- (equal
- (cdr
- (assoc
- "standard::is-volatile"
- (tramp-gvfs-get-file-attributes filename)))
- "TRUE")))
- ;; "gvfs-rename" is not trustworthy.
- (gvfs-operation (if (eq op 'copy) "gvfs-copy" "gvfs-move"))
- (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (tramp-barf-if-file-missing v filename
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
- (when (file-regular-p newname)
- (delete-file newname))
-
- (cond
- ;; We cannot rename volatile files, as used by Google-drive.
- ((and (not equal-remote) volatile)
- (prog1 (copy-file
- filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes)
- (delete-file filename)))
-
- ;; We cannot copy or rename directly.
- ((or (and equal-remote
- (tramp-get-connection-property v "direct-copy-failed"))
- (and t1 (not (tramp-gvfs-file-name-p filename)))
- (and t2 (not (tramp-gvfs-file-name-p newname))))
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file
- filename tmpfile t keep-date preserve-uid-gid
- preserve-extended-attributes)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists)))
-
- ;; Direct action.
- (t (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless
- (and (apply
- #'tramp-gvfs-send-command v gvfs-operation
- (append
- (and (eq op 'copy) (or keep-date preserve-uid-gid)
- '("--preserve"))
- (list
- (tramp-gvfs-url-file-name filename)
- (tramp-gvfs-url-file-name newname))))
- ;; Some backends do not return a proper error
- ;; code in case of direct copy/move. Apply
- ;; sanity checks.
- (or (not equal-remote)
- (and
- (tramp-gvfs-info newname)
- (or (eq op 'copy)
- (not (tramp-gvfs-info filename))))))
-
- (if (or (not equal-remote)
- (and equal-remote
- (tramp-get-connection-property
- v "direct-copy-failed")))
- ;; Propagate the error.
- (with-current-buffer (tramp-get-connection-buffer v)
- (goto-char (point-min))
- (tramp-error-with-buffer
- nil v 'file-error
- "%s failed, see buffer `%s' for details"
- msg-operation (buffer-name)))
-
- ;; Some WebDAV server, like the one from QNAP, do
- ;; not support direct copy/move. Try a fallback.
- (tramp-set-connection-property v "direct-copy-failed" t)
- (tramp-gvfs-do-copy-or-rename-file
- op filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-extended-attributes))))
-
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename nil
- (tramp-flush-file-properties v localname)))
-
- (when t2
- (with-parsed-tramp-file-name newname nil
- (tramp-flush-file-properties v localname))))))))))
+ (cond
+ ;; We cannot rename volatile files, as used by Google-drive.
+ ((and (not equal-remote) volatile)
+ (prog1 (copy-file
+ filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes)
+ (delete-file filename)))
+
+ ;; We cannot copy or rename directly.
+ ((or (and equal-remote
+ (tramp-get-connection-property v "direct-copy-failed"))
+ (and t1 (not (tramp-gvfs-file-name-p filename)))
+ (and t2 (not (tramp-gvfs-file-name-p newname))))
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file
+ filename tmpfile t keep-date preserve-uid-gid
+ preserve-extended-attributes)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists)))
+
+ ;; Direct action.
+ (t (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless
+ (and (apply
+ #'tramp-gvfs-send-command v gvfs-operation
+ (append
+ (and (eq op 'copy) (or keep-date preserve-uid-gid)
+ '("--preserve"))
+ (list
+ (tramp-gvfs-url-file-name filename)
+ (tramp-gvfs-url-file-name newname))))
+ ;; Some backends do not return a proper
+ ;; error code in case of direct copy/move.
+ ;; Apply sanity checks.
+ (or (not equal-remote)
+ (and
+ (tramp-gvfs-info newname)
+ (or (eq op 'copy)
+ (not (tramp-gvfs-info filename))))))
+
+ (if (or (not equal-remote)
+ (and equal-remote
+ (tramp-get-connection-property
+ v "direct-copy-failed")))
+ ;; Propagate the error.
+ (with-current-buffer (tramp-get-connection-buffer v)
+ (goto-char (point-min))
+ (tramp-error-with-buffer
+ nil v 'file-error
+ "%s failed, see buffer `%s' for details"
+ msg-operation (buffer-name)))
+
+ ;; Some WebDAV server, like the one from QNAP,
+ ;; do not support direct copy/move. Try a
+ ;; fallback.
+ (tramp-set-connection-property v "direct-copy-failed" t)
+ (tramp-gvfs-do-copy-or-rename-file
+ op filename newname ok-if-already-exists keep-date
+ preserve-uid-gid preserve-extended-attributes))))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename nil
+ (tramp-flush-file-properties v localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname nil
+ (tramp-flush-file-properties v localname)))))))))))
(defun tramp-gvfs-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
(or (cdr (assoc "standard::size" attributes)) "0")))
;; ... file mode flags
(setq res-filemodes
- (if-let ((n (cdr (assoc "unix::mode" attributes))))
+ (if-let* ((n (cdr (assoc "unix::mode" attributes))))
(tramp-file-mode-from-int (string-to-number n))
(format
"%s%s%s%s------"
"-" "x"))))
;; ... inode and device
(setq res-inode
- (if-let ((n (cdr (assoc "unix::inode" attributes))))
+ (if-let* ((n (cdr (assoc "unix::inode" attributes))))
(string-to-number n)
(tramp-get-inode (tramp-dissect-file-name filename))))
(setq res-device
- (if-let ((n (cdr (assoc "unix::device" attributes))))
+ (if-let* ((n (cdr (assoc "unix::device" attributes))))
(string-to-number n)
(tramp-get-device (tramp-dissect-file-name filename))))
;; The result is cached in `tramp-get-remote-uid'.
(if (equal id-format 'string)
(tramp-file-name-user vec)
- (when-let ((localname
- (tramp-get-connection-property (tramp-get-process vec) "share")))
- (file-attribute-user-id
- (file-attributes (tramp-make-tramp-file-name vec localname) id-format)))))
+ (and-let* ((localname
+ (tramp-get-connection-property (tramp-get-process vec) "share"))
+ ((file-attribute-user-id
+ (file-attributes
+ (tramp-make-tramp-file-name vec localname) id-format)))))))
(defun tramp-gvfs-handle-get-remote-gid (vec id-format)
"The gid of the remote connection VEC, in ID-FORMAT.
ID-FORMAT valid values are `string' and `integer'."
;; The result is cached in `tramp-get-remote-gid'.
- (when-let ((localname
- (tramp-get-connection-property (tramp-get-process vec) "share")))
- (file-attribute-group-id
- (file-attributes (tramp-make-tramp-file-name vec localname) id-format))))
+ (and-let* ((localname
+ (tramp-get-connection-property (tramp-get-process vec) "share"))
+ ((file-attribute-group-id
+ (file-attributes
+ (tramp-make-tramp-file-name vec localname) id-format))))))
(defun tramp-gvfs-handle-set-file-uid-gid (filename &optional uid gid)
"Like `tramp-set-file-uid-gid' for Tramp files."
(setq method "davs"
localname
(concat (tramp-gvfs-get-remote-prefix v) localname)))
- (when (string-equal "mtp" method)
- (when-let
- ((media (tramp-get-connection-property v "media-device")))
- (setq method (tramp-media-device-method media)
- host (tramp-media-device-host media)
- port (tramp-media-device-port media))))
+ (when-let*
+ (((string-equal "mtp" method))
+ (media (tramp-get-connection-property v "media-device")))
+ (setq method (tramp-media-device-method media)
+ host (tramp-media-device-host media)
+ port (tramp-media-device-port media)))
(when (and user domain)
(setq user (concat domain ";" user)))
(url-recreate-url
(string-match (rx bol (+ alnum) "://" (group (+ (not (any "/:"))))) url)
(match-string 1 url)))
+;; This is used in GNU ELPA package tramp-locproc.el.
+(defun tramp-gvfs-local-file-name (filename)
+ "Return local mount name of FILENAME."
+ (setq filename (file-name-unquote (expand-file-name filename)))
+ (with-parsed-tramp-file-name filename nil
+ (with-tramp-file-property v localname "local-file-name"
+ ;; As long as we call `tramp-gvfs-maybe-open-connection' here,
+ ;; we cache the result.
+ (tramp-gvfs-maybe-open-connection v)
+ (let ((quoted (file-name-quoted-p localname))
+ (localname (file-name-unquote localname)))
+ (funcall
+ (if quoted #'file-name-quote #'identity)
+ (expand-file-name
+ (if (file-name-absolute-p localname)
+ (substring localname 1) localname)
+ (tramp-get-file-property v "/" "fuse-mountpoint")))))))
+
\f
;; D-Bus GVFS functions.
(when (member method tramp-media-methods)
;; Ensure that media devices are cached.
(tramp-get-media-devices nil)
- (when-let ((v (tramp-get-connection-property
- (make-tramp-media-device
- :method method :host host :port port)
- "vector" nil)))
+ (when-let* ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector" nil)))
(setq method (tramp-file-name-method v)
host (tramp-file-name-host v)
port (tramp-file-name-port v))))
(when (member method tramp-media-methods)
;; Ensure that media devices are cached.
(tramp-get-media-devices vec)
- (when-let ((v (tramp-get-connection-property
- (make-tramp-media-device
- :method method :host host :port port)
- "vector")))
+ (when-let* ((v (tramp-get-connection-property
+ (make-tramp-media-device
+ :method method :host host :port port)
+ "vector")))
(setq method (tramp-file-name-method v)
host (tramp-file-name-host v)
port (tramp-file-name-port v))))
method '(("smb" . "smb-share")
("davs" . "dav")
("nextcloud" . "dav")
- ("afp". "afp-volume")
+ ("afp" . "afp-volume")
("gdrive" . "google-drive")))
method)
tramp-gvfs-mounttypes)
(defun tramp-get-media-device (vec)
"Transform VEC into a `tramp-media-device' structure.
Check, that respective cache values do exist."
- (if-let ((media (tramp-get-connection-property vec "media-device"))
- (prop (tramp-get-connection-property media "vector")))
+ (if-let* ((media (tramp-get-connection-property vec "media-device"))
+ (prop (tramp-get-connection-property media "vector")))
media
(tramp-get-media-devices vec)
(tramp-get-connection-property vec "media-device")))
;; Preset default "ps" profile for local hosts, based on system type.
-(when-let ((local-profile
- (cond ((eq system-type 'darwin)
- 'tramp-connection-local-darwin-ps-profile)
- ;; ... Add other system types here.
- )))
+(when-let* ((local-profile
+ (cond ((eq system-type 'darwin)
+ 'tramp-connection-local-darwin-ps-profile)
+ ;; ... Add other system types here.
+ )))
(connection-local-set-profiles
`(:application tramp :machine ,(system-name))
local-profile)
(declare-function tramp-file-name-host-port "tramp")
(declare-function tramp-file-name-user-domain "tramp")
(declare-function tramp-get-default-directory "tramp")
+(defvar tramp-repository-branch)
+(defvar tramp-repository-version)
;;;###tramp-autoload
(defcustom tramp-verbose 3
;; Show buffer.
(pop-to-buffer buf)
(discard-input)
- (sit-for tramp-error-show-message-timeout)))
+ (sit-for tramp-error-show-message-timeout 'nodisp)))
;; Reset timestamp. It would be wrong after waiting for a while.
(when (tramp-file-name-equal-p vec (car tramp-current-connection))
(setcdr tramp-current-connection (current-time)))))))
;; `tramp-error' does not show messages. So we must do it ourselves.
(apply #'message fmt-string arguments)
(discard-input)
- (sit-for tramp-error-show-message-timeout)
+ (sit-for tramp-error-show-message-timeout 'nodisp)
;; Reset timestamp. It would be wrong after waiting for a while.
(when
(tramp-file-name-equal-p vec-or-proc (car tramp-current-connection))
(declare (tramp-suppress-trace t))
(let (signal-hook-function)
(apply 'tramp-message vec-or-proc 2 fmt-string arguments)
- (lwarn 'tramp :warning fmt-string arguments)))
+ (apply 'lwarn 'tramp :warning fmt-string arguments)))
(defun tramp-test-message (fmt-string &rest arguments)
"Emit a Tramp message according `default-directory'."
"Goto the linked message in debug buffer at place."
(declare (tramp-suppress-trace t))
(when (mouse-event-p last-input-event) (mouse-set-point last-input-event))
- (when-let ((point (button-get button 'position)))
+ (when-let* ((point (button-get button 'position)))
(goto-char point)))
(define-button-type 'tramp-debug-button-type
;;;###tramp-autoload
(defsubst tramp-rclone-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for rclone."
- (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
- (string= (tramp-file-name-method vec) tramp-rclone-method)))
+ (and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
+ ((string= (tramp-file-name-method vec) tramp-rclone-method)))))
;;;###tramp-autoload
(defun tramp-rclone-file-name-handler (operation &rest args)
"Invoke the rclone handler for OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
- (if-let ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
+ (if-let* ((fn (assoc operation tramp-rclone-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
- (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-scp")
+ (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-scp") ("%c")
("-p" "%k") ("-q") ("-r")))
(tramp-copy-keep-date t)
(tramp-copy-recursive t)))
(tramp-remote-shell-login ("-l"))
(tramp-remote-shell-args ("-c"))
(tramp-copy-program "pscp")
- (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp")
+ (tramp-copy-args (("-l" "%u") ("-P" "%p") ("-sftp") ("%c")
("-p" "%k")))
(tramp-copy-keep-date t)))
'((tramp-login-prompt-regexp tramp-action-login)
(tramp-password-prompt-regexp tramp-action-password)
(tramp-otp-password-prompt-regexp tramp-action-otp-password)
+ (tramp-fingerprint-prompt-regexp tramp-action-fingerprint)
(tramp-wrong-passwd-regexp tramp-action-permission-denied)
(shell-prompt-pattern tramp-action-succeed)
(tramp-shell-prompt-pattern tramp-action-succeed)
;; be expected that this is always a directory.
(or (tramp-string-empty-or-nil-p localname)
(with-tramp-file-property v localname "file-directory-p"
- (if-let
+ (if-let*
((truename (tramp-get-file-property v localname "file-truename"))
((tramp-file-property-p
v (tramp-file-local-name truename) "file-attributes")))
;; test.
(tramp-check-remote-uname v tramp-bsd-unames)
(= (file-attribute-group-id attributes)
- (tramp-get-remote-gid v 'integer)))))))))
+ (tramp-get-remote-gid v 'integer))
+ ;; FIXME: `file-ownership-preserved-p' tests also the
+ ;; ownership of the parent directory. We don't.
+ )))))))
;; Directory listings.
(t2 (tramp-tramp-file-p newname))
target)
(with-parsed-tramp-file-name (if t1 dirname newname) nil
- (unless (file-exists-p dirname)
- (tramp-error v 'file-missing dirname))
-
- ;; `copy-directory-create-symlink' exists since Emacs 28.1.
- (if (and (bound-and-true-p copy-directory-create-symlink)
- (setq target (file-symlink-p dirname))
- (tramp-equal-remote dirname newname))
- (make-symbolic-link
- target
- (if (directory-name-p newname)
- (concat newname (file-name-nondirectory dirname)) newname)
- t)
-
- (if (and (not copy-contents)
- (tramp-get-method-parameter v 'tramp-copy-recursive)
- ;; When DIRNAME and NEWNAME are remote, they must
- ;; have the same method.
- (or (null t1) (null t2)
- (string-equal
- (tramp-file-name-method
- (tramp-dissect-file-name dirname))
- (tramp-file-name-method
- (tramp-dissect-file-name newname)))))
- ;; scp or rsync DTRT.
- (progn
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-already-exists newname))
- (setq dirname (directory-file-name (expand-file-name dirname))
- newname (directory-file-name (expand-file-name newname)))
- (when (and (file-directory-p newname)
- (not (string-equal (file-name-nondirectory dirname)
- (file-name-nondirectory newname))))
- (setq newname
- (expand-file-name
- (file-name-nondirectory dirname) newname)))
- (unless (file-directory-p (file-name-directory newname))
- (make-directory (file-name-directory newname) parents))
- (tramp-do-copy-or-rename-file-out-of-band
- 'copy dirname newname 'ok-if-already-exists keep-date))
-
- ;; We must do it file-wise.
- (tramp-run-real-handler
+ (cond
+ ;; `copy-directory-create-symlink' exists since Emacs 28.1.
+ ((and (bound-and-true-p copy-directory-create-symlink)
+ (setq target (file-symlink-p dirname))
+ (tramp-equal-remote dirname newname))
+ (make-symbolic-link
+ target
+ (if (directory-name-p newname)
+ (concat newname (file-name-nondirectory dirname)) newname)
+ t))
+
+ ;; Shortcut: if method, host, user are the same for both
+ ;; files, we invoke `cp' on the remote host directly.
+ ((and (not copy-contents)
+ (tramp-equal-remote dirname newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
+ (setq dirname (directory-file-name (expand-file-name dirname))
+ newname (directory-file-name (expand-file-name newname)))
+ (tramp-do-copy-or-rename-file-directly
+ 'copy dirname newname
+ 'ok-if-already-exists keep-date 'preserve-uid-gid))
+
+ ;; scp or rsync DTRT.
+ ((and (not copy-contents)
+ (tramp-get-method-parameter v 'tramp-copy-recursive)
+ ;; When DIRNAME and NEWNAME are remote, they must have
+ ;; the same method.
+ (or (null t1) (null t2)
+ (string-equal
+ (tramp-file-name-method (tramp-dissect-file-name dirname))
+ (tramp-file-name-method (tramp-dissect-file-name newname)))))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-already-exists newname))
+ (setq dirname (directory-file-name (expand-file-name dirname))
+ newname (directory-file-name (expand-file-name newname)))
+ (when (and (file-directory-p newname)
+ (not (string-equal (file-name-nondirectory dirname)
+ (file-name-nondirectory newname))))
+ (setq newname
+ (expand-file-name (file-name-nondirectory dirname) newname)))
+ (unless (file-directory-p (file-name-directory newname))
+ (make-directory (file-name-directory newname) parents))
+ (tramp-do-copy-or-rename-file-out-of-band
+ 'copy dirname newname 'ok-if-already-exists keep-date))
+
+ ;; We must do it file-wise.
+ (t (tramp-run-real-handler
#'copy-directory
(list dirname newname keep-date parents copy-contents))))
(progn
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
+ (if (file-symlink-p filename)
+ (progn
+ (make-symbolic-link
+ (file-symlink-p filename) newname ok-if-already-exists)
+ (when (eq op 'rename) (delete-file filename)))
+
+ ;; FIXME: This should be optimized. Computing `file-attributes'
+ ;; checks already, whether the file exists.
+ (let ((t1 (tramp-tramp-file-p filename))
+ (t2 (tramp-tramp-file-p newname))
+ (length (or (file-attribute-size
+ (file-attributes (file-truename filename)))
+ ;; `filename' doesn't exist, for example due
+ ;; to non-existent symlink target.
+ 0))
+ (file-times (file-attribute-modification-time
+ (file-attributes filename)))
+ (file-modes (tramp-default-file-modes filename))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming"))
+ copy-keep-date)
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
- ;; FIXME: This should be optimized. Computing `file-attributes'
- ;; checks already, whether the file exists.
- (let ((t1 (tramp-tramp-file-p filename))
- (t2 (tramp-tramp-file-p newname))
- (length (file-attribute-size
- (file-attributes (file-truename filename))))
- (file-times (file-attribute-modification-time
- (file-attributes filename)))
- (file-modes (tramp-default-file-modes filename))
- (msg-operation (if (eq op 'copy) "Copying" "Renaming"))
- copy-keep-date)
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (unless length
- (tramp-error v 'file-missing filename))
- (tramp-barf-if-file-missing v filename
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
- (cond
- ;; Both are Tramp files.
- ((and t1 t2)
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
- (cond
- ;; Shortcut: if method, host, user are the same for
- ;; both files, we invoke `cp' or `mv' on the remote
- ;; host directly.
- ((tramp-equal-remote filename newname)
- (setq copy-keep-date
- (or (eq op 'rename) keep-date preserve-uid-gid))
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; Try out-of-band operation.
- ((and
- (tramp-method-out-of-band-p v1 length)
- (tramp-method-out-of-band-p v2 length))
- (setq copy-keep-date
- (tramp-get-method-parameter v 'tramp-copy-keep-date))
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname ok-if-already-exists keep-date))
-
- ;; No shortcut was possible. So we copy the file
- ;; first. If the operation was `rename', we go
- ;; back and delete the original file (if the copy
- ;; was successful). The approach is simple-minded:
- ;; we create a new buffer, insert the contents of
- ;; the source file into it, then write out the
- ;; buffer to the target file. The advantage is
- ;; that it doesn't matter which file name handlers
- ;; are used for the source and target file.
- (t
- (tramp-do-copy-or-rename-file-via-buffer
- op filename newname ok-if-already-exists keep-date))))))
-
- ;; One file is a Tramp file, the other one is local.
- ((or t1 t2)
(cond
- ;; Fast track on local machine.
- ((tramp-local-host-p v)
- (setq copy-keep-date
- (or (eq op 'rename) keep-date preserve-uid-gid))
- (tramp-do-copy-or-rename-file-directly
- op filename newname
- ok-if-already-exists keep-date preserve-uid-gid))
-
- ;; If the Tramp file has an out-of-band method, the
- ;; corresponding copy-program can be invoked.
- ((tramp-method-out-of-band-p v length)
- (setq copy-keep-date
- (tramp-get-method-parameter v 'tramp-copy-keep-date))
- (tramp-do-copy-or-rename-file-out-of-band
- op filename newname ok-if-already-exists keep-date))
+ ;; Both are Tramp files.
+ ((and t1 t2)
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+ (cond
+ ;; Shortcut: if method, host, user are the same
+ ;; for both files, we invoke `cp' or `mv' on the
+ ;; remote host directly.
+ ((tramp-equal-remote filename newname)
+ (setq copy-keep-date
+ (or (eq op 'rename) keep-date preserve-uid-gid))
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; Try out-of-band operation.
+ ((and
+ (tramp-method-out-of-band-p v1 length)
+ (tramp-method-out-of-band-p v2 length))
+ (setq copy-keep-date
+ (tramp-get-method-parameter v 'tramp-copy-keep-date))
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname ok-if-already-exists keep-date))
+
+ ;; No shortcut was possible. So we copy the file
+ ;; first. If the operation was `rename', we go
+ ;; back and delete the original file (if the copy
+ ;; was successful). The approach is simple-minded:
+ ;; we create a new buffer, insert the contents of
+ ;; the source file into it, then write out the
+ ;; buffer to the target file. The advantage is
+ ;; that it doesn't matter which file name handlers
+ ;; are used for the source and target file.
+ (t
+ (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname ok-if-already-exists keep-date))))))
+
+ ;; One file is a Tramp file, the other one is local.
+ ((or t1 t2)
+ (cond
+ ;; Fast track on local machine.
+ ((tramp-local-host-p v)
+ (setq copy-keep-date
+ (or (eq op 'rename) keep-date preserve-uid-gid))
+ (tramp-do-copy-or-rename-file-directly
+ op filename newname
+ ok-if-already-exists keep-date preserve-uid-gid))
+
+ ;; If the Tramp file has an out-of-band method, the
+ ;; corresponding copy-program can be invoked.
+ ((tramp-method-out-of-band-p v length)
+ (setq copy-keep-date
+ (tramp-get-method-parameter v 'tramp-copy-keep-date))
+ (tramp-do-copy-or-rename-file-out-of-band
+ op filename newname ok-if-already-exists keep-date))
+
+ ;; Use the inline method via a Tramp buffer.
+ (t (tramp-do-copy-or-rename-file-via-buffer
+ op filename newname ok-if-already-exists keep-date))))
+
+ (t
+ ;; One of them must be a Tramp file.
+ (error "Tramp implementation says this cannot happen")))
+
+ ;; In case of `rename', we must flush the cache of the source file.
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname)))
+
+ ;; NEWNAME has wrong cached values.
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname)))
- ;; Use the inline method via a Tramp buffer.
- (t (tramp-do-copy-or-rename-file-via-buffer
- op filename newname ok-if-already-exists keep-date))))
+ ;; Handle `preserve-extended-attributes'. We ignore
+ ;; possible errors, because ACL strings could be
+ ;; incompatible.
+ (when-let* ((attributes (and preserve-extended-attributes
+ (file-extended-attributes filename))))
+ (ignore-errors
+ (set-file-extended-attributes newname attributes)))
- (t
- ;; One of them must be a Tramp file.
- (error "Tramp implementation says this cannot happen")))
-
- ;; In case of `rename', we must flush the cache of the source file.
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname)))
-
- ;; NEWNAME has wrong cached values.
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname)))
-
- ;; Handle `preserve-extended-attributes'. We ignore
- ;; possible errors, because ACL strings could be
- ;; incompatible.
- (when-let ((attributes (and preserve-extended-attributes
- (file-extended-attributes filename))))
- (ignore-errors
- (set-file-extended-attributes newname attributes)))
-
- ;; KEEP-DATE handling.
- (when (and keep-date (not copy-keep-date))
- (tramp-compat-set-file-times
- newname file-times (unless ok-if-already-exists 'nofollow)))
-
- ;; Set the mode.
- (unless (and keep-date copy-keep-date)
- (set-file-modes newname file-modes))))))))
+ ;; KEEP-DATE handling.
+ (when (and keep-date (not copy-keep-date))
+ (tramp-compat-set-file-times
+ newname file-times (unless ok-if-already-exists 'nofollow)))
+
+ ;; Set the mode.
+ (unless (and keep-date copy-keep-date)
+ (set-file-modes newname file-modes)))))))))
(defun tramp-do-copy-or-rename-file-via-buffer
(op filename newname _ok-if-already-exists _keep-date)
;; Compose copy command.
(setq options
(format-spec
- (tramp-ssh-controlmaster-options v)
+ (tramp-ssh-or-plink-options v)
(format-spec-make
?t (tramp-get-connection-property
(tramp-get-connection-process v) "temp-file" "")))
(rx bol (group (* blank) "total")) nil t)
;; Emacs 29.1 or later.
(not (fboundp 'dired--insert-disk-space)))
- (when-let ((available (get-free-disk-space ".")))
+ (when-let* ((available (get-free-disk-space ".")))
;; Replace "total" with "total used", to avoid confusion.
(replace-match "\\1 used in directory")
(end-of-line)
;; needed when sending signals remotely.
(let ((pid (tramp-send-command-and-read v "echo $$")))
(setq p (tramp-get-connection-process v))
- (process-put p 'remote-pid pid)
- (tramp-set-connection-property p "remote-pid" pid))
+ (process-put p 'remote-pid pid))
(when (memq connection-type '(nil pipe))
;; Disable carriage return to newline
;; translation. This does not work on
;; character to read. When a process does
;; not read from stdin, like magit, it
;; should set a timeout
- ;; instead. See`tramp-pipe-stty-settings'.
+ ;; instead. See `tramp-pipe-stty-settings'.
;; (Bug#62093)
;; FIXME: Shall we rather use "stty raw"?
(tramp-send-command
(setq ret (tramp-send-command-and-check
v (format
"cd %s && %s"
- (tramp-unquote-shell-quote-argument localname)
- command)
+ (tramp-shell-quote-argument localname) command)
t t t))
(unless (natnump ret) (setq ret 1))
;; We should add the output anyway.
(defun tramp-sh-handle-file-local-copy (filename)
"Like `file-local-copy' for Tramp files."
(tramp-skeleton-file-local-copy filename
- (if-let ((size (file-attribute-size (file-attributes filename))))
+ (if-let* ((size (file-attribute-size (file-attributes filename))))
(let (rem-enc loc-dec)
(condition-case err
;; requires a remote command (the file cache must be invalidated).
;; Therefore, we apply a kind of optimization. We install the file
;; name handler `tramp-vc-file-name-handler', which does nothing but
-;; remembers all file names for which `file-exists-p' or
-;; `file-readable-p' has been applied. A first run of `vc-registered'
-;; is performed. Afterwards, a script is applied for all collected
-;; file names, using just one remote command. The result of this
-;; script is used to fill the file cache with actual values. Now we
-;; can reset the file name handlers, and we make a second run of
-;; `vc-registered', which returns the expected result without sending
-;; any other remote command.
+;; remembers all file names for which `file-exists-p',
+;; `file-readable-p' or `file-directory-p' has been applied. A first
+;; run of `vc-registered' is performed. Afterwards, a script is
+;; applied for all collected file names, using just one remote
+;; command. The result of this script is used to fill the file cache
+;; with actual values. Now we can reset the file name handlers, and
+;; we make a second run of `vc-registered', which returns the expected
+;; result without sending any other remote command.
;; When called during `revert-buffer', it shouldn't spam the echo area
;; and the *Messages* buffer.
(defun tramp-sh-handle-vc-registered (file)
;; Send just one command, in order to fill the cache.
(tramp-bundle-read-file-names v tramp-vc-registered-file-names))
- ;; Second run. Now all `file-exists-p' or `file-readable-p'
- ;; calls shall be answered from the file cache. We unset
- ;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
- ;; in order to keep the cache.
+ ;; Second run. Now all `file-exists-p', `file-readable-p'
+ ;; or `file-directory-p' calls shall be answered from the
+ ;; file cache. We unset `process-file-side-effects' and
+ ;; `remote-file-name-inhibit-cache' in order to keep the
+ ;; cache.
(let ((vc-handled-backends (copy-sequence vc-handled-backends))
remote-file-name-inhibit-cache process-file-side-effects)
;; Reduce `vc-handled-backends' in order to minimize
(defun tramp-sh-file-name-handler (operation &rest args)
"Invoke remote-shell Tramp file name handler.
Fall back to normal file name handler if no Tramp handler exists."
- (if-let ((fn (assoc operation tramp-sh-file-name-handler-alist)))
+ (if-let* ((fn (assoc operation tramp-sh-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
(defun tramp-vc-file-name-handler (operation &rest args)
"Invoke special file name handler, which collects files to be handled."
(save-match-data
- (let ((filename
- (tramp-replace-environment-variables
- (apply #'tramp-file-name-for-operation operation args)))
- (fn (assoc operation tramp-sh-file-name-handler-alist)))
- (if (tramp-tramp-file-p filename)
- (with-parsed-tramp-file-name filename nil
- (cond
- ;; That's what we want: file names, for which checks are
- ;; applied. We assume that VC uses only `file-exists-p'
- ;; and `file-readable-p' checks; otherwise we must extend
- ;; the list. We do not perform any action, but return
- ;; nil, in order to keep `vc-registered' running.
- ((and fn (memq operation '(file-exists-p file-readable-p)))
- (add-to-list 'tramp-vc-registered-file-names localname 'append)
- nil)
- ;; `process-file' and `start-file-process' shall be ignored.
- ((and fn (eq operation 'process-file) 0))
- ((and fn (eq operation 'start-file-process) nil))
- ;; Tramp file name handlers like `expand-file-name'. They
- ;; must still work.
- (fn (save-match-data (apply (cdr fn) args)))
- ;; Default file name handlers, we don't care.
- (t (tramp-run-real-handler operation args))))
-
- ;; When `tramp-mode' is not enabled, or the file name is
- ;; quoted, we don't do anything.
- (tramp-run-real-handler operation args)))))
+ (if-let* ((filename
+ (tramp-replace-environment-variables
+ (apply #'tramp-file-name-for-operation operation args)))
+ ((tramp-tramp-file-p filename))
+ (fn (assoc operation tramp-sh-file-name-handler-alist)))
+ (with-parsed-tramp-file-name filename nil
+ (cond
+ ;; That's what we want: file names, for which checks are
+ ;; applied. We assume that VC uses only `file-exists-p',
+ ;; `file-readable-p' and `file-directory-p' checks;
+ ;; otherwise we must extend the list. The respective cache
+ ;; value must be set for these functions in
+ ;; `tramp-bundle-read-file-names'.
+ ;; We do not perform any action, but return nil, in order
+ ;; to keep `vc-registered' running.
+ ((memq operation '(file-exists-p file-readable-p file-directory-p))
+ (add-to-list 'tramp-vc-registered-file-names localname 'append)
+ nil)
+ ;; `process-file' and `start-file-process' shall be ignored.
+ ((eq operation 'process-file) 0)
+ ((eq operation 'start-file-process) nil)
+ ;; Tramp file name handlers like `expand-file-name'. They
+ ;; must still work.
+ (t (save-match-data (apply (cdr fn) args)))))
+
+ ;; When `tramp-mode' is not enabled, or the file name is not a
+ ;; remote file name, we don't do anything. Same for default
+ ;; file name handlers.
+ (tramp-run-real-handler operation args))))
(defun tramp-sh-handle-file-notify-add-watch (file-name flags _callback)
"Like `file-notify-add-watch' for Tramp files."
(zerop
(tramp-call-process vec "ssh" nil nil nil "-G" "-o" option "0.0.0.1"))))
-(defun tramp-ssh-controlmaster-options (vec)
- "Return the Control* arguments of the local ssh."
+(defun tramp-plink-option-exists-p (vec option)
+ "Check, whether local plink OPTION is applicable."
+ ;; We don't want to cache it persistently.
+ (with-tramp-connection-property nil option
+ ;; "plink" with valid options returns "plink: no valid host name
+ ;; provided". We xcheck for this error message."
+ (with-temp-buffer
+ (tramp-call-process vec "plink" nil t nil option)
+ (not
+ (string-match-p
+ (rx (| (: "plink: unknown option \"" (literal option) "\"" )
+ (: "plink: option \"" (literal option)
+ "\" not available in this tool" )))
+ (buffer-string))))))
+
+(defun tramp-ssh-or-plink-options (vec)
+ "Return additional arguments of the local ssh or plink."
(cond
;; No options to be computed.
- ((or (null tramp-use-connection-share)
- (null (assoc "%c" (tramp-get-method-parameter vec 'tramp-login-args))))
- "")
+ ((null (assoc "%c" (tramp-get-method-parameter vec 'tramp-login-args))) "")
- ;; Use plink option.
+ ;; Use plink options.
((string-match-p
(rx "plink" (? ".exe") eol)
(tramp-get-method-parameter vec 'tramp-login-program))
- (if (eq tramp-use-connection-share 'suppress)
- "-noshare" "-share"))
+ (concat
+ (if (eq tramp-use-connection-share 'suppress)
+ "-noshare" "-share")
+ ;; Since PuTTY 0.82.
+ (when (tramp-plink-option-exists-p vec "-legacy-stdio-prompts")
+ " -legacy-stdio-prompts")))
;; There is already a value to be used.
((and (eq tramp-use-connection-share t)
(stringp tramp-ssh-controlmaster-options))
tramp-ssh-controlmaster-options)
- ;; We can't auto-compute the options.
- ((ignore-errors
- (not (tramp-ssh-option-exists-p vec "ControlMaster=auto")))
- "")
-
- ;; Determine the options.
- (t (ignore-errors
- ;; ControlMaster and ControlPath options are introduced in OpenSSH 3.9.
- (concat
- "-o ControlMaster="
- (if (eq tramp-use-connection-share 'suppress)
+ ;; Use ssh options.
+ (tramp-use-connection-share
+ ;; We can't auto-compute the options.
+ (if (ignore-errors
+ (not (tramp-ssh-option-exists-p vec "ControlMaster=auto")))
+ ""
+
+ ;; Determine the options.
+ (ignore-errors
+ ;; ControlMaster and ControlPath options are introduced in OpenSSH 3.9.
+ (concat
+ "-o ControlMaster="
+ (if (eq tramp-use-connection-share 'suppress)
"no" "auto")
- " -o ControlPath="
- (if (eq tramp-use-connection-share 'suppress)
+ " -o ControlPath="
+ (if (eq tramp-use-connection-share 'suppress)
"none"
;; Hashed tokens are introduced in OpenSSH 6.7. On macOS
;; we cannot use an absolute file name, it is too long.
(or small-temporary-file-directory
tramp-compat-temporary-file-directory))))
- ;; ControlPersist option is introduced in OpenSSH 5.6.
+ ;; ControlPersist option is introduced in OpenSSH 5.6.
(when (and (not (eq tramp-use-connection-share 'suppress))
(tramp-ssh-option-exists-p vec "ControlPersist=no"))
- " -o ControlPersist=no"))))))
+ " -o ControlPersist=no")))))
+
+ ;; Return a string, whatsoever.
+ (t "")))
(defun tramp-scp-strict-file-name-checking (vec)
"Return the strict file name checking argument of the local scp."
(let* ((current-host tramp-system-name)
(target-alist (tramp-compute-multi-hops vec))
(previous-hop tramp-null-hop)
- ;; We will apply `tramp-ssh-controlmaster-options'
+ ;; We will apply `tramp-ssh-or-plink-options'
;; only for the first hop.
- (options (tramp-ssh-controlmaster-options vec))
+ (options (tramp-ssh-or-plink-options vec))
(process-connection-type tramp-process-connection-type)
(process-adaptive-read-buffering nil)
;; There are unfortunate settings for "cmdproxy"
(setq r-shell t)))
(setq current-host l-host)
- ;; Set password prompt vector.
+ ;; Set hop and password prompt vector.
+ (tramp-set-connection-property p "hop-vector" hop)
(tramp-set-connection-property
- p "password-vector"
+ p "pw-vector"
(if (tramp-get-method-parameter
hop 'tramp-password-previous-hop)
(let ((pv (copy-tramp-file-name previous-hop)))
:host l-host :port l-port)))
;; Set session timeout.
- (when-let ((timeout
- (tramp-get-method-parameter
- hop 'tramp-session-timeout)))
+ (when-let* ((timeout
+ (tramp-get-method-parameter
+ hop 'tramp-session-timeout)))
(tramp-set-connection-property
p "session-timeout" timeout))
tramp-actions-before-shell connection-timeout))
;; Next hop.
+ (tramp-flush-connection-property p "hop-vector")
+ (tramp-flush-connection-property p "pw-vector")
(setq options ""
target-alist (cdr target-alist)
previous-hop hop)))
(lambda (x) (not (tramp-get-file-property vec x "file-directory-p")))
remote-path))))))
-;; The PIPE_BUF in POSIX [1] can be as low as 512 [2]. Here are the values
+;; The PIPE_BUF in POSIX [1] can be as low as 512 [2]. Here are the values
;; on various platforms:
;; - 512 on macOS, FreeBSD, NetBSD, OpenBSD, MirBSD, native Windows.
;; - 4 KiB on Linux, OSF/1, Cygwin, Haiku.
;; - 8 KiB on HP-UX, Plan9.
;; - 10 KiB on IRIX.
;; - 32 KiB on AIX, Minix.
+;; - `undefined' on QNX.
;; [1] https://pubs.opengroup.org/onlinepubs/9699919799/functions/write.html
;; [2] https://pubs.opengroup.org/onlinepubs/9699919799/basedefs/limits.h.html
;; See Bug#65324.
(defun tramp-get-remote-pipe-buf (vec)
"Return PIPE_BUF config from the remote side."
(with-tramp-connection-property vec "pipe-buf"
- (tramp-send-command-and-read
- vec
- (format "getconf PIPE_BUF / 2>%s || echo 4096"
- (tramp-get-remote-null-device vec))
- 'noerror)))
+ (if-let* ((result
+ (tramp-send-command-and-read
+ vec (format "getconf PIPE_BUF / 2>%s"
+ (tramp-get-remote-null-device vec))
+ 'noerror))
+ ((natnump result)))
+ result 4096)))
(defun tramp-get-remote-locale (vec)
"Determine remote locale, supporting UTF8 if possible."
(dolist (cmd
;; Prefer GNU ls on *BSD and macOS.
(if (tramp-check-remote-uname vec tramp-bsd-unames)
- '( "gls" "ls" "gnuls") '("ls" "gnuls" "gls")))
+ '("gls" "ls" "gnuls") '("ls" "gnuls" "gls")))
(let ((dl (tramp-get-remote-path vec))
result)
(while (and dl (setq result (tramp-find-executable vec cmd dl t t)))
(with-tramp-connection-property vec "awk"
(tramp-message vec 5 "Finding a suitable `awk' command")
(or (tramp-find-executable vec "awk" (tramp-get-remote-path vec))
- (let* ((busybox (tramp-get-remote-busybox vec))
- (command (format "%s %s" busybox "awk")))
- (and busybox
- (tramp-send-command-and-check
- vec (concat command " {} <" (tramp-get-remote-null-device vec)))
- command)))))
+ (when-let*
+ ((busybox (tramp-get-remote-busybox vec))
+ (command (format "%s %s" busybox "awk"))
+ ((tramp-send-command-and-check
+ vec (concat command " {} <" (tramp-get-remote-null-device vec)))))
+ command))))
(defun tramp-get-remote-hexdump (vec)
"Determine remote `hexdump' command."
(with-tramp-connection-property vec "hexdump"
(tramp-message vec 5 "Finding a suitable `hexdump' command")
(or (tramp-find-executable vec "hexdump" (tramp-get-remote-path vec))
- (let* ((busybox (tramp-get-remote-busybox vec))
- (command (format "%s %s" busybox "hexdump")))
- (and busybox
- (tramp-send-command-and-check
- vec (concat command " <" (tramp-get-remote-null-device vec)))
- command)))))
+ (when-let*
+ ((busybox (tramp-get-remote-busybox vec))
+ (command (format "%s %s" busybox "hexdump"))
+ ((tramp-send-command-and-check
+ vec (concat command " <" (tramp-get-remote-null-device vec)))))
+ command))))
(defun tramp-get-remote-od (vec)
"Determine remote `od' command."
(with-tramp-connection-property vec "od"
(tramp-message vec 5 "Finding a suitable `od' command")
(or (tramp-find-executable vec "od" (tramp-get-remote-path vec))
- (let* ((busybox (tramp-get-remote-busybox vec))
- (command (format "%s %s" busybox "od")))
- (and busybox
- (tramp-send-command-and-check
- vec
- (concat command " -A n <" (tramp-get-remote-null-device vec)))
- command)))))
+ (when-let*
+ ((busybox (tramp-get-remote-busybox vec))
+ (command (format "%s %s" busybox "od"))
+ ((tramp-send-command-and-check
+ vec
+ (concat command " -A n <" (tramp-get-remote-null-device vec)))))
+ command))))
(defun tramp-get-remote-chmod-h (vec)
"Check whether remote `chmod' supports nofollow argument."
"Read from server failed, maybe it closed the connection"
"Call timed out: server did not respond"
(: (+ (not blank)) ": command not found")
+ (: (+ (not blank)) " does not exist")
"Server doesn't support UNIX CIFS calls"
(| ;; Samba.
"ERRDOS"
;;;###tramp-autoload
(defsubst tramp-smb-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for SMB servers."
- (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
- (string= (tramp-file-name-method vec) tramp-smb-method)))
+ (and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
+ ((string= (tramp-file-name-method vec) tramp-smb-method)))))
;;;###tramp-autoload
(defun tramp-smb-file-name-handler (operation &rest args)
"Invoke the SMB related OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
- (if-let ((fn (assoc operation tramp-smb-file-name-handler-alist)))
+ (if-let* ((fn (assoc operation tramp-smb-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
(t2 (tramp-tramp-file-p newname))
target)
(with-parsed-tramp-file-name (if t1 dirname newname) nil
- (unless (file-exists-p dirname)
- (tramp-error v 'file-missing dirname))
-
;; `copy-directory-create-symlink' exists since Emacs 28.1.
(if (and (bound-and-true-p copy-directory-create-symlink)
(setq target (file-symlink-p dirname))
PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are completely ignored."
(setq filename (expand-file-name filename)
newname (expand-file-name newname))
- (with-tramp-progress-reporter
- (tramp-dissect-file-name
- (if (tramp-tramp-file-p filename) filename newname))
- 0 (format "Copying %s to %s" filename newname)
- (if (file-directory-p filename)
- (copy-directory filename newname keep-date 'parents 'copy-contents)
+ (with-parsed-tramp-file-name
+ (if (tramp-tramp-file-p filename) filename newname) nil
+ (with-tramp-progress-reporter
+ v 0 (format "Copying %s to %s" filename newname)
+
+ (if (file-directory-p filename)
+ (copy-directory filename newname keep-date 'parents 'copy-contents)
+
+ (tramp-barf-if-file-missing v filename
+ ;; `file-local-copy' returns a file name also for a local
+ ;; file with `jka-compr-handler', so we cannot trust its
+ ;; result as indication for a remote file name.
+ (if-let* ((tmpfile
+ (and (tramp-tramp-file-p filename)
+ (file-local-copy filename))))
+ ;; Remote filename.
+ (condition-case err
+ (rename-file tmpfile newname ok-if-already-exists)
+ ((error quit)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Remote newname.
+ (when (and (file-directory-p newname)
+ (directory-name-p newname))
+ (setq newname
+ (expand-file-name
+ (file-name-nondirectory filename) newname)))
+
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (unless (tramp-smb-get-share v)
+ (tramp-error
+ v 'file-error "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v (format "put %s %s"
+ (tramp-smb-shell-quote-argument filename)
+ (tramp-smb-shell-quote-localname v)))
+ (tramp-error
+ v 'file-error "Cannot copy `%s' to `%s'" filename newname))
+
+ ;; When newname did exist, we have wrong cached values.
+ (when (tramp-tramp-file-p newname)
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname))))))
- (unless (file-exists-p filename)
- (tramp-error
- (tramp-dissect-file-name
- (if (tramp-tramp-file-p filename) filename newname))
- 'file-missing filename))
-
- ;; `file-local-copy' returns a file name also for a local file
- ;; with `jka-compr-handler', so we cannot trust its result as
- ;; indication for a remote file name.
- (if-let ((tmpfile
- (and (tramp-tramp-file-p filename) (file-local-copy filename))))
- ;; Remote filename.
- (condition-case err
- (rename-file tmpfile newname ok-if-already-exists)
- ((error quit)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Remote newname.
- (when (and (file-directory-p newname)
- (directory-name-p newname))
- (setq newname
- (expand-file-name (file-name-nondirectory filename) newname)))
-
- (with-parsed-tramp-file-name newname nil
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (unless (tramp-smb-get-share v)
- (tramp-error
- v 'file-error "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v (format "put %s %s"
- (tramp-smb-shell-quote-argument filename)
- (tramp-smb-shell-quote-localname v)))
- (tramp-error
- v 'file-error "Cannot copy `%s' to `%s'" filename newname))
-
- ;; When newname did exist, we have wrong cached values.
- (when (tramp-tramp-file-p newname)
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname))))))
-
- ;; KEEP-DATE handling.
- (when keep-date
- (tramp-compat-set-file-times
- newname
- (file-attribute-modification-time (file-attributes filename))
- (unless ok-if-already-exists 'nofollow)))))
+ ;; KEEP-DATE handling.
+ (when keep-date
+ (tramp-compat-set-file-times
+ newname
+ (file-attribute-modification-time (file-attributes filename))
+ (unless ok-if-already-exists 'nofollow))))))
(defun tramp-smb-handle-delete-directory (directory &optional recursive trash)
"Like `delete-directory' for Tramp files."
(tramp-error v 'file-error "Cannot expand tilde in file `%s'" name))
(unless (tramp-run-real-handler #'file-name-absolute-p (list localname))
(setq localname (concat "/" localname)))
- ;; Do not keep "/..".
+ ;; Do not keep "/..".
(when (string-match-p (rx bos "/" (** 1 2 ".") eos) localname)
(setq localname "/"))
;; Do normal `expand-file-name' (this does "/./" and "/../"),
(forward-line)
(delete-region (point-min) (point)))
(while (and (not (eobp)) (looking-at-p (rx bol (+ nonl) ":" (+ nonl))))
- (forward-line))
+ (forward-line))
(delete-region (point) (point-max))
(throw 'tramp-action 'ok))))
"Implement `file-attributes' for Tramp files using `stat' command."
(tramp-message
vec 5 "file attributes with stat: %s" (tramp-file-name-localname vec))
- (let* (size id link uid gid atime mtime ctime mode inode)
+ (let (size id link uid gid atime mtime ctime mode inode)
(when (tramp-smb-send-command
vec (format "stat %s" (tramp-smb-shell-quote-localname vec)))
(with-parsed-tramp-file-name
(if (tramp-tramp-file-p filename) filename newname) nil
- (unless (file-exists-p filename)
- (tramp-error v 'file-missing filename))
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
- (with-tramp-progress-reporter
- v 0 (format "Renaming %s to %s" filename newname)
-
- (if (and (not (file-exists-p newname))
- (tramp-equal-remote filename newname)
- (string-equal
- (tramp-smb-get-share (tramp-dissect-file-name filename))
- (tramp-smb-get-share (tramp-dissect-file-name newname))))
- ;; We can rename directly.
- (with-parsed-tramp-file-name filename v1
- (with-parsed-tramp-file-name newname v2
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v1 v1-localname)
- (tramp-flush-file-properties v2 v2-localname)
- (unless (tramp-smb-get-share v2)
- (tramp-error
- v2 'file-error
- "Target `%s' must contain a share name" newname))
- (unless (tramp-smb-send-command
- v2 (format "rename %s %s"
- (tramp-smb-shell-quote-localname v1)
- (tramp-smb-shell-quote-localname v2)))
- (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
-
- ;; We must rename via copy.
- (copy-file
- filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
- (if (file-directory-p filename)
- (delete-directory filename 'recursive)
- (delete-file filename))))))
+ (with-tramp-progress-reporter
+ v 0 (format "Renaming %s to %s" filename newname)
+
+ (if (and (not (file-exists-p newname))
+ (tramp-equal-remote filename newname)
+ (string-equal
+ (tramp-smb-get-share (tramp-dissect-file-name filename))
+ (tramp-smb-get-share (tramp-dissect-file-name newname))))
+ ;; We can rename directly.
+ (with-parsed-tramp-file-name filename v1
+ (with-parsed-tramp-file-name newname v2
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v1 v1-localname)
+ (tramp-flush-file-properties v2 v2-localname)
+ (unless (tramp-smb-get-share v2)
+ (tramp-error
+ v2 'file-error
+ "Target `%s' must contain a share name" newname))
+ (unless (tramp-smb-send-command
+ v2 (format "rename %s %s"
+ (tramp-smb-shell-quote-localname v1)
+ (tramp-smb-shell-quote-localname v2)))
+ (tramp-error v2 'file-error "Cannot rename `%s'" filename))))
+
+ ;; We must rename via copy.
+ (copy-file
+ filename newname ok-if-already-exists 'keep-time 'preserve-uid-gid)
+ (if (file-directory-p filename)
+ (delete-directory filename 'recursive)
+ (delete-file filename)))))))
(defun tramp-smb-action-set-acl (proc vec)
"Set ACL data."
;;;###tramp-autoload
(defsubst tramp-sshfs-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for sshfs."
- (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
- (string= (tramp-file-name-method vec) tramp-sshfs-method)))
+ (and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
+ ((string= (tramp-file-name-method vec) tramp-sshfs-method)))))
;;;###tramp-autoload
(defun tramp-sshfs-file-name-handler (operation &rest args)
"Invoke the sshfs handler for OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
- (if-let ((fn (assoc operation tramp-sshfs-file-name-handler-alist)))
+ (if-let* ((fn (assoc operation tramp-sshfs-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
(defun tramp-sshfs-handle-process-file
(program &optional infile destination display &rest args)
"Like `process-file' for Tramp files."
+ ;; STDERR is not impelmemted.
+ (when (consp destination)
+ (setcdr destination `(,tramp-cache-undefined)))
(tramp-skeleton-process-file program infile destination display args
(let ((coding-system-for-read 'utf-8-dos)) ; Is this correct?
(tramp-unquote-shell-quote-argument localname)
(mapconcat #'tramp-shell-quote-argument (cons program args) " ")))
(when input (setq command (format "%s <%s" command input)))
- (when stderr (setq command (format "%s 2>%s" command stderr)))
-
- (unwind-protect
- (setq ret
- (apply
- #'tramp-call-process
- v (tramp-get-method-parameter v 'tramp-login-program)
- nil outbuf display
- (tramp-expand-args
- v 'tramp-login-args nil
- ?h (or (tramp-file-name-host v) "")
- ?u (or (tramp-file-name-user v) "")
- ?p (or (tramp-file-name-port v) "")
- ?a "-t" ?l command)))
-
- ;; Synchronize stderr.
- (when tmpstderr
- (tramp-cleanup-connection v 'keep-debug 'keep-password)
- (tramp-fuse-unmount v))))))
+
+ (setq ret
+ (apply
+ #'tramp-call-process
+ v (tramp-get-method-parameter v 'tramp-login-program)
+ nil outbuf display
+ (tramp-expand-args
+ v 'tramp-login-args nil
+ ?h (or (tramp-file-name-host v) "")
+ ?u (or (tramp-file-name-user v) "")
+ ?p (or (tramp-file-name-port v) "")
+ ?a "-t" ?l command))))))
(defun tramp-sshfs-handle-rename-file
(filename newname &optional ok-if-already-exists)
;;;###tramp-autoload
(defsubst tramp-sudoedit-file-name-p (vec-or-filename)
"Check if it's a VEC-OR-FILENAME for SUDOEDIT."
- (when-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename)))
- (string= (tramp-file-name-method vec) tramp-sudoedit-method)))
+ (and-let* ((vec (tramp-ensure-dissected-file-name vec-or-filename))
+ ((string= (tramp-file-name-method vec) tramp-sudoedit-method)))))
;;;###tramp-autoload
(defun tramp-sudoedit-file-name-handler (operation &rest args)
"Invoke the SUDOEDIT handler for OPERATION and ARGS.
First arg specifies the OPERATION, second arg is a list of
arguments to pass to the OPERATION."
- (if-let ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
+ (if-let* ((fn (assoc operation tramp-sudoedit-file-name-handler-alist)))
(prog1 (save-match-data (apply (cdr fn) args))
(setq tramp-debug-message-fnh-function (cdr fn)))
(prog1 (tramp-run-real-handler operation args)
(unless (memq op '(copy rename))
(error "Unknown operation `%s', must be `copy' or `rename'" op))
- (setq filename (file-truename filename))
(if (file-directory-p filename)
(progn
(copy-directory filename newname keep-date t)
(when (eq op 'rename) (delete-directory filename 'recursive)))
-
- ;; FIXME: This should be optimized. Computing `file-attributes'
- ;; checks already, whether the file exists.
- (let ((t1 (tramp-sudoedit-file-name-p filename))
- (t2 (tramp-sudoedit-file-name-p newname))
- (file-times (file-attribute-modification-time
- (file-attributes filename)))
- (file-modes (tramp-default-file-modes filename))
- (attributes (and preserve-extended-attributes
- (file-extended-attributes filename)))
- (sudoedit-operation
- (cond
- ((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
- ((eq op 'copy) '("cp" "-f"))
- ((eq op 'rename) '("mv" "-f"))))
- (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
-
- (with-parsed-tramp-file-name (if t1 filename newname) nil
- (tramp-barf-if-file-missing v filename
- (when (and (not ok-if-already-exists) (file-exists-p newname))
- (tramp-error v 'file-already-exists newname))
- (when (and (file-directory-p newname)
- (not (directory-name-p newname)))
- (tramp-error v 'file-error "File is a directory %s" newname))
-
- (if (or (and (tramp-tramp-file-p filename) (not t1))
- (and (tramp-tramp-file-p newname) (not t2)))
- ;; We cannot copy or rename directly.
- (let ((tmpfile (tramp-compat-make-temp-file filename)))
- (if (eq op 'copy)
- (copy-file filename tmpfile t)
- (rename-file filename tmpfile t))
- (rename-file tmpfile newname ok-if-already-exists))
-
- ;; Direct action.
- (with-tramp-progress-reporter
- v 0 (format "%s %s to %s" msg-operation filename newname)
- (unless (tramp-sudoedit-send-command
- v sudoedit-operation
- (tramp-unquote-file-local-name filename)
- (tramp-unquote-file-local-name newname))
- (tramp-error
- v 'file-error
- "Error %s `%s' `%s'" msg-operation filename newname))))
-
- ;; When `newname' is local, we must change the ownership to
- ;; the local user.
- (unless (tramp-tramp-file-p newname)
- (tramp-set-file-uid-gid
- (concat (file-remote-p filename) newname)
- (tramp-get-local-uid 'integer)
- (tramp-get-local-gid 'integer)))
-
- ;; Set the time and mode. Mask possible errors.
- (when keep-date
- (ignore-errors
- (tramp-compat-set-file-times
- newname file-times (unless ok-if-already-exists 'nofollow))
- (set-file-modes newname file-modes)))
-
- ;; Handle `preserve-extended-attributes'. We ignore possible
- ;; errors, because ACL strings could be incompatible.
- (when attributes
- (ignore-errors
- (set-file-extended-attributes newname attributes)))
-
- (when (and t1 (eq op 'rename))
- (with-parsed-tramp-file-name filename v1
- (tramp-flush-file-properties v1 v1-localname)))
-
- (when t2
- (with-parsed-tramp-file-name newname v2
- (tramp-flush-file-properties v2 v2-localname))))))))
+ (if (file-symlink-p filename)
+ (progn
+ (make-symbolic-link
+ (file-symlink-p filename) newname ok-if-already-exists)
+ (when (eq op 'rename) (delete-file filename)))
+
+ ;; FIXME: This should be optimized. Computing `file-attributes'
+ ;; checks already, whether the file exists.
+ (let ((t1 (tramp-sudoedit-file-name-p filename))
+ (t2 (tramp-sudoedit-file-name-p newname))
+ (file-times (file-attribute-modification-time
+ (file-attributes filename)))
+ (file-modes (tramp-default-file-modes filename))
+ (attributes (and preserve-extended-attributes
+ (file-extended-attributes filename)))
+ (sudoedit-operation
+ (cond
+ ((and (eq op 'copy) preserve-uid-gid) '("cp" "-f" "-p"))
+ ((eq op 'copy) '("cp" "-f"))
+ ((eq op 'rename) '("mv" "-f"))))
+ (msg-operation (if (eq op 'copy) "Copying" "Renaming")))
+
+ (with-parsed-tramp-file-name (if t1 filename newname) nil
+ (tramp-barf-if-file-missing v filename
+ (when (and (not ok-if-already-exists) (file-exists-p newname))
+ (tramp-error v 'file-already-exists newname))
+ (when (and (file-directory-p newname)
+ (not (directory-name-p newname)))
+ (tramp-error v 'file-error "File is a directory %s" newname))
+
+ (if (or (and (tramp-tramp-file-p filename) (not t1))
+ (and (tramp-tramp-file-p newname) (not t2)))
+ ;; We cannot copy or rename directly.
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
+ (if (eq op 'copy)
+ (copy-file filename tmpfile t)
+ (rename-file filename tmpfile t))
+ (rename-file tmpfile newname ok-if-already-exists))
+
+ ;; Direct action.
+ (with-tramp-progress-reporter
+ v 0 (format "%s %s to %s" msg-operation filename newname)
+ (unless (tramp-sudoedit-send-command
+ v sudoedit-operation
+ (tramp-unquote-file-local-name filename)
+ (tramp-unquote-file-local-name newname))
+ (tramp-error
+ v 'file-error
+ "Error %s `%s' `%s'" msg-operation filename newname))))
+
+ ;; When `newname' is local, we must change the ownership
+ ;; to the local user.
+ (unless (tramp-tramp-file-p newname)
+ (tramp-set-file-uid-gid
+ (concat (file-remote-p filename) newname)
+ (tramp-get-local-uid 'integer)
+ (tramp-get-local-gid 'integer)))
+
+ ;; Set the time and mode. Mask possible errors.
+ (when keep-date
+ (ignore-errors
+ (tramp-compat-set-file-times
+ newname file-times (unless ok-if-already-exists 'nofollow))
+ (set-file-modes newname file-modes)))
+
+ ;; Handle `preserve-extended-attributes'. We ignore possible
+ ;; errors, because ACL strings could be incompatible.
+ (when attributes
+ (ignore-errors
+ (set-file-extended-attributes newname attributes)))
+
+ (when (and t1 (eq op 'rename))
+ (with-parsed-tramp-file-name filename v1
+ (tramp-flush-file-properties v1 v1-localname)))
+
+ (when t2
+ (with-parsed-tramp-file-name newname v2
+ (tramp-flush-file-properties v2 v2-localname)))))))))
(defun tramp-sudoedit-handle-copy-file
(filename newname &optional ok-if-already-exists keep-date
;; Avoid process status message in output buffer.
(set-process-sentinel p #'ignore)
(tramp-post-process-creation p vec)
- (tramp-set-connection-property p "password-vector" tramp-sudoedit-null-hop)
+ (tramp-set-connection-property p "pw-vector" tramp-sudoedit-null-hop)
(tramp-process-actions p vec nil tramp-sudoedit-sudo-actions)
(tramp-message vec 6 "%s\n%s" (process-exit-status p) (buffer-string))
(prog1
:version "22.1"
:link '(custom-manual "(tramp)Top"))
-;; Maybe we need once a real Tramp mode, with key bindings etc.
;;;###autoload
-(defcustom tramp-mode t
+(defcustom tramp-mode (fboundp 'make-process) ; Disable on MS-DOS.
"Whether Tramp is enabled.
If it is set to nil, all remote file names are used literally."
:type 'boolean)
(defcustom tramp-otp-password-prompt-regexp
(rx-to-string
`(: bol (* nonl)
- ;; JumpCloud.
- (group (| "Verification code"))
+ (group (|
+ ;; JumpCloud.
+ "Verification code"
+ ;; TACC HPC. <https://docs.tacc.utexas.edu/basics/mfa/>
+ "TACC Token Code"))
(* nonl) (any . ,tramp-compat-password-colon-equivalents) (* blank)))
"Regexp matching one-time password prompts.
The regexp should match at end of buffer."
- :version "29.2"
+ :version "30.2"
:type 'regexp)
(defcustom tramp-wrong-passwd-regexp
"No supported authentication methods left to try!"
(: "Login " (| "Incorrect" "incorrect"))
(: "Connection " (| "refused" "closed"))
- (: "Received signal " (+ digit)))
+ (: "Received signal " (+ digit))
+ ;; Fingerprint.
+ "Verification timed out"
+ "Failed to match fingerprint"
+ "An unknown error occurred")
(* nonl))
"Regexp matching a `login failed' message.
The regexp should match at end of buffer."
:type 'regexp)
+;; <https://gitlab.freedesktop.org/libfprint/fprintd/-/blob/master/pam/fingerprint-strings.h?ref_type=heads>
+(defcustom tramp-fingerprint-prompt-regexp
+ (rx (| "Place your finger on"
+ "Swipe your finger across"
+ "Place your left thumb on"
+ "Swipe your left thumb across"
+ "Place your left index finger on"
+ "Swipe your left index finger across"
+ "Place your left middle finger on"
+ "Swipe your left middle finger across"
+ "Place your left ring finger on"
+ "Swipe your left ring finger across"
+ "Place your left little finger on"
+ "Swipe your left little finger across"
+ "Place your right thumb on"
+ "Swipe your right thumb across"
+ "Place your right index finger on"
+ "Swipe your right index finger across"
+ "Place your right middle finger on"
+ "Swipe your right middle finger across"
+ "Place your right ring finger on"
+ "Swipe your right ring finger across"
+ "Place your right little finger on"
+ "Swipe your right little finger across"
+ "Place your finger on the reader again"
+ "Swipe your finger again"
+ "Swipe was too short, try again"
+ "Your finger was not centred, try swiping your finger again"
+ "Remove your finger, and try swiping your finger again")
+ (* nonl) (* (any "\r\n")))
+ "Regexp matching fingerprint prompts.
+The regexp should match at end of buffer."
+ :version "30.2"
+ :type 'regexp)
+
(defcustom tramp-yesno-prompt-regexp
(rx "Are you sure you want to continue connecting (yes/no"
(? "/[fingerprint]") ")?"
"method: "
(tramp-compat-seq-keep
(lambda (x)
- (when-let ((name (symbol-name x))
- ;; It must match `tramp-enable-METHOD-method'.
- ((string-match
- (rx "tramp-enable-"
- (group (regexp tramp-method-regexp))
- "-method")
- name))
- (method (match-string 1 name))
- ;; It must not be enabled yet.
- ((not (assoc method tramp-methods))))
+ (when-let* ((name (symbol-name x))
+ ;; It must match `tramp-enable-METHOD-method'.
+ ((string-match
+ (rx "tramp-enable-"
+ (group (regexp tramp-method-regexp))
+ "-method")
+ name))
+ (method (match-string 1 name))
+ ;; It must not be enabled yet.
+ ((not (assoc method tramp-methods))))
method))
;; All method enabling functions.
(mapcar
#'intern (all-completions "tramp-enable-" obarray #'functionp))))))
- (when-let (((not (assoc method tramp-methods)))
- (fn (intern (format "tramp-enable-%s-method" method)))
- ((functionp fn)))
+ (when-let* (((not (assoc method tramp-methods)))
+ (fn (intern (format "tramp-enable-%s-method" method)))
+ ((functionp fn)))
(funcall fn)
(message "Tramp method \"%s\" enabled" method)))
;; We use the cached property.
(tramp-get-connection-property vec hash-entry)
;; Use the static value from `tramp-methods'.
- (if-let ((methods-entry
- (assoc
- param (assoc (tramp-file-name-method vec) tramp-methods))))
+ (if-let* ((methods-entry
+ (assoc
+ param (assoc (tramp-file-name-method vec) tramp-methods))))
(cadr methods-entry)
;; Return the default value.
default))))
;;;###tramp-autoload
(defsubst tramp-string-empty-or-nil-p (string)
"Check whether STRING is empty or nil."
+ ;; (declare (tramp-suppress-trace t))
(or (null string) (string= string "")))
+;; We cannot use the `declare' form for `tramp-suppress-trace' in
+;; autoloaded functions, because the tramp-loaddefs.el generation
+;; would fail.
+(function-put #'tramp-string-empty-or-nil-p 'tramp-suppress-trace t)
+
(defun tramp-buffer-name (vec)
"A name for the connection buffer VEC."
(declare (tramp-suppress-trace t))
`(condition-case ,err
(progn ,@body)
(error
- (if (not (file-exists-p ,filename))
+ (if (not (or (file-exists-p ,filename) (file-symlink-p ,filename)))
(tramp-error ,vec 'file-missing ,filename)
(signal (car ,err) (cdr ,err)))))))
;; We start a pulsing progress reporter after 3 seconds.
;; Start only when there is no other progress reporter
;; running, and when there is a minimum level.
- (when-let ((pr (and (null tramp-inhibit-progress-reporter)
- (<= ,level (min tramp-verbose 3))
- (make-progress-reporter ,message))))
+ (when-let* ((pr (and (null tramp-inhibit-progress-reporter)
+ (<= ,level (min tramp-verbose 3))
+ (make-progress-reporter ,message))))
(run-at-time 3 0.1 #'tramp-progress-reporter-update pr))))
(unwind-protect
;; Execute the body.
(let ((seconds (car list))
(timeout-forms (cdr list)))
;; If non-nil, `seconds' must be a positive number.
- `(if-let (((natnump ,seconds))
- ((not (zerop timeout))))
+ `(if-let* (((natnump ,seconds))
+ ((not (zerop timeout))))
(with-timeout (,seconds ,@timeout-forms) ,@body)
,@body)))
(defun tramp-completion-file-name-handler (operation &rest args)
"Invoke Tramp file name completion handler for OPERATION and ARGS.
Falls back to normal file name handler if no Tramp file name handler exists."
- (if-let
+ (if-let*
((fn (and tramp-mode minibuffer-completing-file-name
(assoc operation tramp-completion-file-name-handler-alist))))
(save-match-data (apply (cdr fn) args))
;; If jka-compr or epa-file are already loaded, move them to the
;; front of `file-name-handler-alist'.
(dolist (fnh '(epa-file-handler jka-compr-handler))
- (when-let ((entry (rassoc fnh file-name-handler-alist)))
+ (when-let* ((entry (rassoc fnh file-name-handler-alist)))
(setq file-name-handler-alist
(cons entry (delete entry file-name-handler-alist))))))
(when (tramp-connectable-p ,filename)
(with-parsed-tramp-file-name (expand-file-name ,filename) nil
(with-tramp-file-property v localname "file-exists-p"
- ;; Examine `file-attributes' cache to see if request can
- ;; be satisfied without remote operation.
- (if (tramp-file-property-p v localname "file-attributes")
- (not
- (null (tramp-get-file-property v localname "file-attributes")))
- ,@body))))))
+ (cond
+ ;; Examine `file-attributes' cache to see if request can
+ ;; be satisfied without remote operation.
+ ((and-let*
+ (((tramp-file-property-p v localname "file-attributes"))
+ (fa (tramp-get-file-property v localname "file-attributes"))
+ ((not (stringp (car fa)))))))
+ ;; Symlink to a non-existing target counts as nil.
+ ;; Protect against cyclic symbolic links.
+ ((file-symlink-p ,filename)
+ (ignore-errors
+ (file-exists-p (file-truename ,filename))))
+ (t ,@body)))))))
(defmacro tramp-skeleton-file-local-copy (filename &rest body)
"Skeleton for `tramp-*-handle-file-local-copy'.
(setf ,target (tramp-file-local-name (expand-file-name ,target))))
;; There could be a cyclic link.
(tramp-flush-file-properties
- v (expand-file-name ,target (tramp-file-local-name default-directory))))
+ v (tramp-drop-volume-letter
+ (expand-file-name
+ ,target (tramp-file-local-name default-directory)))))
;; If TARGET is still remote, quote it.
(if (tramp-tramp-file-p ,target)
tmpstderr (tramp-make-tramp-file-name v stderr))))
;; stderr to be discarded.
((null (cadr ,destination))
- (setq stderr (tramp-get-remote-null-device v)))))
+ (setq stderr (tramp-get-remote-null-device v)))
+ ((eq (cadr ,destination) tramp-cache-undefined)
+ ;; stderr is not impelmemted.
+ (tramp-warning v "%s" "STDERR not supported"))))
;; t
(,destination
- (setq outbuf (current-buffer))))
+ (setq outbuf (current-buffer))))
,@body
;; We cannot add "file-attributes", "file-executable-p",
;; "file-ownership-preserved-p", "file-readable-p",
;; "file-writable-p".
- '("file-directory-p" "file-exists-p" "file-symlinkp" "file-truename")
+ '("file-directory-p" "file-exists-p" "file-symlink-p" "file-truename")
(tramp-flush-file-properties v localname))
(condition-case err
(progn ,@body)
(let (last-coding-system-used (need-chown t))
;; Set file modification time.
(when (or (eq ,visit t) (stringp ,visit))
- (when-let ((file-attr (file-attributes filename 'integer)))
+ (when-let* ((file-attr (file-attributes filename 'integer)))
(set-visited-file-modtime
;; We must pass modtime explicitly, because FILENAME
;; can be different from (buffer-file-name), f.e. if
(tramp-dont-suspend-timers t))
(with-tramp-timeout
(timeout
- (unless (when-let ((p (tramp-get-connection-process v)))
- (and (process-live-p p)
- (tramp-get-connection-property p "connected")))
+ (unless (and-let* ((p (tramp-get-connection-process v))
+ ((process-live-p p))
+ ((tramp-get-connection-property p "connected"))))
(tramp-cleanup-connection v 'keep-debug 'keep-password))
(tramp-error
v 'file-error
(defun tramp-handle-file-directory-p (filename)
"Like `file-directory-p' for Tramp files."
;; `file-truename' could raise an error, for example due to a cyclic
- ;; symlink. We don't protect this despite it, because other errors
- ;; might be worth to be visible, for example impossibility to mount
- ;; in tramp-gvfs.el.
- (eq (file-attribute-type (file-attributes (file-truename filename))) t))
+ ;; symlink.
+ (ignore-errors
+ (eq (file-attribute-type (file-attributes (file-truename filename))) t)))
(defun tramp-handle-file-equal-p (filename1 filename2)
"Like `file-equalp-p' for Tramp files."
(defun tramp-handle-file-modes (filename &optional flag)
"Like `file-modes' for Tramp files."
- (when-let ((attrs (file-attributes filename))
- (mode-string (file-attribute-modes attrs)))
+ (when-let* ((attrs (file-attributes filename))
+ (mode-string (file-attribute-modes attrs)))
(if (and (not (eq flag 'nofollow)) (eq ?l (aref mode-string 0)))
(file-modes (file-truename filename))
(tramp-mode-string-to-int mode-string))))
(or (tramp-check-cached-permissions v ?r)
;; `tramp-check-cached-permissions' doesn't handle symbolic
;; links.
- (when-let ((symlink (file-symlink-p filename)))
- (and (stringp symlink)
- (file-readable-p
- (concat (file-remote-p filename) symlink))))))))
+ (and-let* ((symlink (file-symlink-p filename))
+ ((stringp symlink))
+ ((file-readable-p
+ (concat (file-remote-p filename) symlink)))))))))
(defun tramp-handle-file-regular-p (filename)
"Like `file-regular-p' for Tramp files."
;; because `file-truename' could raise an error for cyclic
;; symlinks.
(ignore-errors
- (when-let ((attr (file-attributes filename)))
+ (when-let* ((attr (file-attributes filename)))
(cond
((eq ?- (aref (file-attribute-modes attr) 0)))
((eq ?l (aref (file-attribute-modes attr) 0))
(defun tramp-get-lock-file (file)
"Read lockfile info of FILE.
Return nil when there is no lockfile."
- (when-let ((lockname (tramp-compat-make-lock-file-name file)))
+ (when-let* ((lockname (tramp-compat-make-lock-file-name file)))
(or (file-symlink-p lockname)
(and (file-readable-p lockname)
(with-temp-buffer
(defun tramp-handle-file-locked-p (file)
"Like `file-locked-p' for Tramp files."
- (when-let ((info (tramp-get-lock-file file))
- (match (string-match tramp-lock-file-info-regexp info)))
+ (when-let* ((info (tramp-get-lock-file file))
+ (match (string-match tramp-lock-file-info-regexp info)))
(or ; Locked by me.
(and (string-equal (match-string 1 info) (user-login-name))
(string-equal (match-string 2 info) tramp-system-name)
;; for remote files.
(ask-user-about-supersession-threat file))
- (when-let ((info (tramp-get-lock-file file))
- (match (string-match tramp-lock-file-info-regexp info)))
+ (when-let* ((info (tramp-get-lock-file file))
+ (match (string-match tramp-lock-file-info-regexp info)))
(unless (ask-user-about-lock
file (format
"%s@%s (pid %s)" (match-string 1 info)
(match-string 2 info) (match-string 3 info)))
(throw 'dont-lock nil)))
- (when-let ((lockname (tramp-compat-make-lock-file-name file))
- ;; USER@HOST.PID[:BOOT_TIME]
- (info
- (format
- "%s@%s.%s" (user-login-name) tramp-system-name
- (tramp-get-lock-pid file))))
+ (when-let* ((lockname (tramp-compat-make-lock-file-name file))
+ ;; USER@HOST.PID[:BOOT_TIME]
+ (info
+ (format
+ "%s@%s.%s" (user-login-name) tramp-system-name
+ (tramp-get-lock-pid file))))
;; Protect against security hole.
(with-parsed-tramp-file-name file nil
;; When there is no connection, we don't do it. Otherwise,
;; functions like `kill-buffer' would try to reestablish the
;; connection. See Bug#61663.
- (if-let ((v (tramp-dissect-file-name file))
- ((process-live-p (tramp-get-process v)))
- (lockname (tramp-compat-make-lock-file-name file)))
+ (if-let* ((v (tramp-dissect-file-name file))
+ ((process-live-p (tramp-get-process v)))
+ (lockname (tramp-compat-make-lock-file-name file)))
(delete-file lockname)
;; Trigger the unlock error. Be quiet if user isn't
;; interested in lock files. See Bug#70900.
(defun tramp-add-hops (vec)
"Add ad-hoc proxy definitions to `tramp-default-proxies-alist'."
- (when-let ((hops (tramp-file-name-hop vec))
- (item vec))
+ (when-let* ((hops (tramp-file-name-hop vec))
+ (item vec))
(let (signal-hook-function changed)
(dolist
(proxy (reverse (split-string hops tramp-postfix-hop-regexp 'omit)))
(item vec)
choices proxy)
- ;; Ad-hoc proxy definitions.
- (tramp-add-hops vec)
-
- ;; Look for proxy hosts to be passed.
- (setq choices tramp-default-proxies-alist)
- (while choices
- (setq item (pop choices)
- proxy (eval (nth 2 item) t))
- (when (and
- ;; Host.
- (string-match-p
- (or (eval (nth 0 item) t) "")
- (or (tramp-file-name-host-port (car target-alist)) ""))
- ;; User.
- (string-match-p
- (or (eval (nth 1 item) t) "")
- (or (tramp-file-name-user-domain (car target-alist)) "")))
- (if (null proxy)
- ;; No more hops needed.
- (setq choices nil)
- ;; Replace placeholders.
- (setq proxy
- (format-spec
- proxy
- (format-spec-make
- ?u (or (tramp-file-name-user (car target-alist)) "")
- ?h (or (tramp-file-name-host (car target-alist)) ""))))
- (with-parsed-tramp-file-name proxy l
- ;; Add the hop.
- (push l target-alist)
- ;; Start next search.
- (setq choices tramp-default-proxies-alist)))))
-
- ;; Foreign and out-of-band methods are not supported for multi-hops.
- (when (cdr target-alist)
- (setq choices target-alist)
- (while (setq item (pop choices))
- (unless (tramp-multi-hop-p item)
- (setq tramp-default-proxies-alist saved-tdpa)
- (tramp-user-error
- vec "Method `%s' is not supported for multi-hops"
- (tramp-file-name-method item)))))
-
- ;; Some methods ("su", "sg", "sudo", "doas", "run0", "ksu") do not
- ;; use the host name in their command template. In this case, the
- ;; remote file name must use either a local host name (first hop),
- ;; or a host name matching the previous hop.
- (let ((previous-host (or tramp-local-host-regexp "")))
- (setq choices target-alist)
- (while (setq item (pop choices))
- (let ((host (tramp-file-name-host item)))
- (unless
- (or
- ;; The host name is used for the remote shell command.
- (member
- "%h" (flatten-tree
- (tramp-get-method-parameter item 'tramp-login-args)))
- ;; The host name must match previous hop.
- (string-match-p previous-host host))
+ ;; `tramp-compute-multi-hops' could be called also for other file
+ ;; name handlers, for example in `tramp-clear-passwd'.
+ (when (tramp-sh-file-name-handler-p vec)
+
+ ;; Ad-hoc proxy definitions.
+ (tramp-add-hops vec)
+
+ ;; Look for proxy hosts to be passed.
+ (setq choices tramp-default-proxies-alist)
+ (while choices
+ (setq item (pop choices)
+ proxy (eval (nth 2 item) t))
+ (when (and
+ ;; Host.
+ (string-match-p
+ (or (eval (nth 0 item) t) "")
+ (or (tramp-file-name-host-port (car target-alist)) ""))
+ ;; User.
+ (string-match-p
+ (or (eval (nth 1 item) t) "")
+ (or (tramp-file-name-user-domain (car target-alist)) "")))
+ (if (null proxy)
+ ;; No more hops needed.
+ (setq choices nil)
+ ;; Replace placeholders.
+ (setq proxy
+ (format-spec
+ proxy
+ (format-spec-make
+ ?u (or (tramp-file-name-user (car target-alist)) "")
+ ?h (or (tramp-file-name-host (car target-alist)) ""))))
+ (with-parsed-tramp-file-name proxy l
+ ;; Add the hop.
+ (push l target-alist)
+ ;; Start next search.
+ (setq choices tramp-default-proxies-alist)))))
+
+ ;; Foreign and out-of-band methods are not supported for
+ ;; multi-hops.
+ (when (cdr target-alist)
+ (setq choices target-alist)
+ (while (setq item (pop choices))
+ (unless (tramp-multi-hop-p item)
(setq tramp-default-proxies-alist saved-tdpa)
(tramp-user-error
- vec "Host name `%s' does not match `%s'" host previous-host))
- (setq previous-host (rx bol (literal host) eol)))))
+ vec "Method `%s' is not supported for multi-hops"
+ (tramp-file-name-method item)))))
+
+ ;; Some methods ("su", "sg", "sudo", "doas", "run0", "ksu") do
+ ;; not use the host name in their command template. In this
+ ;; case, the remote file name must use either a local host name
+ ;; (first hop), or a host name matching the previous hop.
+ (let ((previous-host (or tramp-local-host-regexp "")))
+ (setq choices target-alist)
+ (while (setq item (pop choices))
+ (let ((host (tramp-file-name-host item)))
+ (unless
+ (or
+ ;; The host name is used for the remote shell command.
+ (member
+ "%h" (flatten-tree
+ (tramp-get-method-parameter item 'tramp-login-args)))
+ ;; The host name must match previous hop.
+ (string-match-p previous-host host))
+ (setq tramp-default-proxies-alist saved-tdpa)
+ (tramp-user-error
+ vec "Host name `%s' does not match `%s'" host previous-host))
+ (setq previous-host (rx bol (literal host) eol))))))
;; Result.
target-alist))
elt (default-toplevel-value 'process-environment))))
(setq env (cons elt env)))))
;; Add remote path if exists.
- (env (if-let ((sh-file-name-handler-p)
- (remote-path
- (string-join (tramp-get-remote-path v) ":")))
+ (env (if-let* ((sh-file-name-handler-p)
+ (remote-path
+ (string-join (tramp-get-remote-path v) ":")))
(setenv-internal env "PATH" remote-path 'keep)
env))
;; Add HISTFILE if indicated.
- (env (if-let ((sh-file-name-handler-p))
+ (env (if sh-file-name-handler-p
(cond
((stringp tramp-histfile-override)
(setenv-internal
(insert-file-contents-literally
error-file nil nil nil 'replace))
(delete-file error-file)))))
- (display-buffer output-buffer '(nil (allow-no-window . t)))))
-
+ (if async-shell-command-display-buffer
+ ;; Display buffer immediately.
+ (display-buffer output-buffer '(nil (allow-no-window . t)))
+ ;; Defer displaying buffer until first process output.
+ ;; Use disposable named advice so that the buffer is
+ ;; displayed at most once per process lifetime.
+ (let ((nonce (make-symbol "nonce")))
+ (add-function
+ :before (process-filter p)
+ (lambda (proc _string)
+ (let ((buf (process-buffer proc)))
+ (when (buffer-live-p buf)
+ (remove-function (process-filter proc)
+ nonce)
+ (display-buffer buf '(nil (allow-no-window . t))))))
+ `((name . ,nonce)))))))
;; Insert error messages if they were separated.
(when (and error-file (not (process-live-p p)))
(ignore-errors
;; Sometimes, the process returns a new password request
;; immediately after rejecting the previous (wrong) one.
(unless (or tramp-password-prompt-not-unique
- (tramp-get-connection-property vec "first-password-request"))
+ (tramp-get-connection-property
+ (tramp-get-connection-property
+ proc "hop-vector"
+ (process-get proc 'tramp-vector))
+ "first-password-request"))
(tramp-clear-passwd vec))
(goto-char (point-min))
(tramp-check-for-regexp proc tramp-process-action-regexp)
(narrow-to-region (point-max) (point-max))))
t)
+(defcustom tramp-use-fingerprint t
+ "Whether fingerprint prompts shall be used for authentication."
+ :version "30.2"
+ :type 'boolean)
+
+(defun tramp-action-fingerprint (proc vec)
+ "Query the user for a fingerprint verification.
+Interrupt the query if `tramp-use-fingerprint' is nil."
+ (with-current-buffer (process-buffer proc)
+ (if tramp-use-fingerprint
+ (tramp-action-show-message proc vec)
+ (interrupt-process proc)
+ ;; Hide message.
+ (narrow-to-region (point-max) (point-max))))
+ t)
+
(defun tramp-action-succeed (_proc _vec)
"Signal success in finding shell prompt."
(throw 'tramp-action 'ok))
(tramp-send-string vec (concat tramp-terminal-type tramp-local-end-of-line))
t)
+(defun tramp-action-show-message (proc vec)
+ "Show the user a message for confirmation.
+Wait, until the connection buffer changes."
+ (with-current-buffer (process-buffer proc)
+ (let ((cursor-in-echo-area t)
+ set-message-function clear-message-function tramp-dont-suspend-timers)
+ (with-tramp-suspended-timers
+ ;; Silence byte compiler.
+ (ignore set-message-function clear-message-function)
+ (tramp-message vec 6 "\n%s" (buffer-string))
+ (goto-char (point-min))
+ (tramp-check-for-regexp proc tramp-process-action-regexp)
+ (with-temp-message (concat (string-trim (match-string 0)) " ")
+ ;; Hide message in buffer.
+ (narrow-to-region (point-max) (point-max))
+ ;; Wait for new output.
+ (while (tramp-compat-length= (buffer-string) 0)
+ (tramp-accept-process-output proc))))))
+ t)
+
(defun tramp-action-confirm-message (_proc vec)
"Return RET in order to confirm the message."
(tramp-message
;; Silence byte compiler.
(ignore set-message-function clear-message-function)
(tramp-message vec 6 "\n%s" (buffer-string))
+ (goto-char (point-min))
(tramp-check-for-regexp proc tramp-process-action-regexp)
(with-temp-message (concat (string-trim (match-string 0)) " ")
;; Hide message in buffer.
result. The symbol `ok' means that all ACTIONs have been
performed successfully. Any other value means an error."
;; Enable `auth-source', unless "emacs -Q" has been called. We must
- ;; use the "password-vector" property in case we have several hops.
+ ;; use the "hop-vector" property in case we have several hops.
(tramp-set-connection-property
(tramp-get-connection-property
- proc "password-vector" (process-get proc 'tramp-vector))
+ proc "hop-vector" (process-get proc 'tramp-vector))
"first-password-request" tramp-cache-read-persistent-data)
(save-restriction
(with-tramp-progress-reporter
;; communication. This could block the output for the current
;; process. Read such output first. (Bug#61350)
;; The process property isn't set anymore due to Bug#62194.
- (when-let (((process-get proc 'tramp-shared-socket))
- (v (process-get proc 'tramp-vector)))
+ (when-let* (((process-get proc 'tramp-shared-socket))
+ (v (process-get proc 'tramp-vector)))
(dolist (p (delq proc (process-list)))
(when (tramp-file-name-equal-p v (process-get p 'tramp-vector))
(with-tramp-suspended-timers
(let ((found (tramp-check-for-regexp proc regexp)))
(with-tramp-timeout (timeout)
(while (not found)
+ ;; This is needed to yield the CPU, otherwise we'll see 100% CPU load.
+ (sit-for 0 'nodisp)
(tramp-accept-process-output proc)
(unless (process-live-p proc)
(tramp-error-with-buffer
must be non-negative integers.
The setgid bit of the upper directory is respected.
If FILENAME is remote, a file name handler is called."
- (let* ((dir (file-name-directory filename))
- (modes (file-modes dir)))
- (when (and modes (not (zerop (logand modes #o2000))))
- (setq gid (file-attribute-group-id (file-attributes dir)))))
+ (when-let* ((dir (file-name-directory filename))
+ (modes (file-modes dir))
+ ((not (zerop (logand modes #o2000)))))
+ (setq gid (file-attribute-group-id (file-attributes dir))))
(if (tramp-tramp-file-p filename)
(funcall (if (tramp-crypt-file-name-p filename)
"Check `file-attributes' caches for VEC.
Return t if according to the cache access type ACCESS is known to
be granted."
- (when-let ((offset (cond
- ((eq ?r access) 1)
- ((eq ?w access) 2)
- ((eq ?x access) 3)
- ((eq ?s access) 3)))
- (file-attr (file-attributes (tramp-make-tramp-file-name vec)))
- (remote-uid (tramp-get-remote-uid vec 'integer))
- (remote-gid (tramp-get-remote-gid vec 'integer)))
+ (when-let* ((offset (cond
+ ((eq ?r access) 1)
+ ((eq ?w access) 2)
+ ((eq ?x access) 3)
+ ((eq ?s access) 3)))
+ (file-attr (file-attributes (tramp-make-tramp-file-name vec)))
+ (remote-uid (tramp-get-remote-uid vec 'integer))
+ (remote-gid (tramp-get-remote-gid vec 'integer)))
(or
;; Not a symlink.
(eq t (file-attribute-type file-attr))
Set file uid and gid according to ID-FORMAT. LOCALNAME is used
to cache the result. Return the modified ATTR."
(declare (indent 3) (debug t))
- `(with-tramp-file-property
- ,vec ,localname (format "file-attributes-%s" (or ,id-format 'integer))
- (when-let
- ((result
- (with-tramp-file-property ,vec ,localname "file-attributes"
- (when-let ((attr ,attr))
- (save-match-data
- ;; Remove ANSI control escape sequences from symlink.
+ `(when-let*
+ ((result
+ (with-tramp-file-property ,vec ,localname "file-attributes"
+ (when-let* ((attr ,attr))
+ (save-match-data
+ ;; Remove ANSI control escape sequences from symlink.
+ (when (stringp (car attr))
+ (while (string-match ansi-color-control-seq-regexp (car attr))
+ (setcar attr (replace-match "" nil nil (car attr)))))
+ ;; Convert uid and gid. Use `tramp-unknown-id-integer'
+ ;; as indication of unusable value.
+ (when (consp (nth 2 attr))
+ (when (and (numberp (cdr (nth 2 attr)))
+ (< (cdr (nth 2 attr)) 0))
+ (setcdr (car (nthcdr 2 attr)) tramp-unknown-id-integer))
+ (when (and (floatp (cdr (nth 2 attr)))
+ (<= (cdr (nth 2 attr)) most-positive-fixnum))
+ (setcdr (car (nthcdr 2 attr)) (round (cdr (nth 2 attr))))))
+ (when (consp (nth 3 attr))
+ (when (and (numberp (cdr (nth 3 attr)))
+ (< (cdr (nth 3 attr)) 0))
+ (setcdr (car (nthcdr 3 attr)) tramp-unknown-id-integer))
+ (when (and (floatp (cdr (nth 3 attr)))
+ (<= (cdr (nth 3 attr)) most-positive-fixnum))
+ (setcdr (car (nthcdr 3 attr)) (round (cdr (nth 3 attr))))))
+ ;; Convert last access time.
+ (unless (listp (nth 4 attr))
+ (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr))))
+ ;; Convert last modification time.
+ (unless (listp (nth 5 attr))
+ (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr))))
+ ;; Convert last status change time.
+ (unless (listp (nth 6 attr))
+ (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr))))
+ ;; Convert file size.
+ (when (< (nth 7 attr) 0)
+ (setcar (nthcdr 7 attr) -1))
+ (when (and (floatp (nth 7 attr))
+ (<= (nth 7 attr) most-positive-fixnum))
+ (setcar (nthcdr 7 attr) (round (nth 7 attr))))
+ ;; Convert file mode bits to string.
+ (unless (stringp (nth 8 attr))
+ (setcar (nthcdr 8 attr)
+ (tramp-file-mode-from-int (nth 8 attr)))
(when (stringp (car attr))
- (while (string-match ansi-color-control-seq-regexp (car attr))
- (setcar attr (replace-match "" nil nil (car attr)))))
- ;; Convert uid and gid. Use `tramp-unknown-id-integer'
- ;; as indication of unusable value.
- (when (consp (nth 2 attr))
- (when (and (numberp (cdr (nth 2 attr)))
- (< (cdr (nth 2 attr)) 0))
- (setcdr (car (nthcdr 2 attr)) tramp-unknown-id-integer))
- (when (and (floatp (cdr (nth 2 attr)))
- (<= (cdr (nth 2 attr)) most-positive-fixnum))
- (setcdr (car (nthcdr 2 attr)) (round (cdr (nth 2 attr))))))
- (when (consp (nth 3 attr))
- (when (and (numberp (cdr (nth 3 attr)))
- (< (cdr (nth 3 attr)) 0))
- (setcdr (car (nthcdr 3 attr)) tramp-unknown-id-integer))
- (when (and (floatp (cdr (nth 3 attr)))
- (<= (cdr (nth 3 attr)) most-positive-fixnum))
- (setcdr (car (nthcdr 3 attr)) (round (cdr (nth 3 attr))))))
- ;; Convert last access time.
- (unless (listp (nth 4 attr))
- (setcar (nthcdr 4 attr) (seconds-to-time (nth 4 attr))))
- ;; Convert last modification time.
- (unless (listp (nth 5 attr))
- (setcar (nthcdr 5 attr) (seconds-to-time (nth 5 attr))))
- ;; Convert last status change time.
- (unless (listp (nth 6 attr))
- (setcar (nthcdr 6 attr) (seconds-to-time (nth 6 attr))))
- ;; Convert file size.
- (when (< (nth 7 attr) 0)
- (setcar (nthcdr 7 attr) -1))
- (when (and (floatp (nth 7 attr))
- (<= (nth 7 attr) most-positive-fixnum))
- (setcar (nthcdr 7 attr) (round (nth 7 attr))))
- ;; Convert file mode bits to string.
- (unless (stringp (nth 8 attr))
- (setcar (nthcdr 8 attr)
- (tramp-file-mode-from-int (nth 8 attr)))
- (when (stringp (car attr))
- (aset (nth 8 attr) 0 ?l)))
- ;; Convert directory indication bit.
- (when (string-prefix-p "d" (nth 8 attr))
- (setcar attr t))
- ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
- ;; Decode also multibyte string.
- (when (consp (car attr))
- (setcar attr
- (and (stringp (caar attr))
- (string-match
- (rx (+ nonl) " -> " nonl (group (+ nonl)) nonl)
- (caar attr))
- (decode-coding-string
- (match-string 1 (caar attr)) 'utf-8))))
- ;; Set file's gid change bit.
- (setcar
- (nthcdr 9 attr)
- (not (= (cdr (nth 3 attr))
- (or (tramp-get-remote-gid ,vec 'integer)
- tramp-unknown-id-integer))))
- ;; Convert inode.
- (when (floatp (nth 10 attr))
- (setcar (nthcdr 10 attr)
- (condition-case nil
- (let ((high (nth 10 attr))
- middle low)
+ (aset (nth 8 attr) 0 ?l)))
+ ;; Convert directory indication bit.
+ (when (string-prefix-p "d" (nth 8 attr))
+ (setcar attr t))
+ ;; Convert symlink from `tramp-do-file-attributes-with-stat'.
+ ;; Decode also multibyte string.
+ (when (consp (car attr))
+ (setcar attr
+ (and (stringp (caar attr))
+ (string-match
+ (rx (+ nonl) " -> " nonl (group (+ nonl)) nonl)
+ (caar attr))
+ (decode-coding-string
+ (match-string 1 (caar attr)) 'utf-8))))
+ ;; Set file's gid change bit.
+ (setcar
+ (nthcdr 9 attr)
+ (not (= (cdr (nth 3 attr))
+ (or (tramp-get-remote-gid ,vec 'integer)
+ tramp-unknown-id-integer))))
+ ;; Convert inode.
+ (when (floatp (nth 10 attr))
+ (setcar (nthcdr 10 attr)
+ (condition-case nil
+ (let ((high (nth 10 attr))
+ middle low)
+ (if (<= high most-positive-fixnum)
+ (floor high)
+ ;; The low 16 bits.
+ (setq low (mod high #x10000)
+ high (/ high #x10000))
(if (<= high most-positive-fixnum)
- (floor high)
- ;; The low 16 bits.
- (setq low (mod high #x10000)
- high (/ high #x10000))
- (if (<= high most-positive-fixnum)
- (cons (floor high) (floor low))
- ;; The middle 24 bits.
- (setq middle (mod high #x1000000)
- high (/ high #x1000000))
- (cons (floor high)
- (cons (floor middle) (floor low))))))
- ;; Inodes can be incredible huge. We
- ;; must hide this.
- (error (tramp-get-inode ,vec)))))
- ;; Set virtual device number.
- (setcar (nthcdr 11 attr)
- (tramp-get-device ,vec))
- ;; Set SELinux context.
- (when (stringp (nth 12 attr))
- (tramp-set-file-property
- ,vec ,localname "file-selinux-context"
- (split-string (nth 12 attr) ":" 'omit)))
- ;; Remove optional entries.
- (setcdr (nthcdr 11 attr) nil)
- attr)))))
-
- ;; Return normalized result.
- (append (tramp-compat-take 2 result)
- (if (eq ,id-format 'string)
- (list (car (nth 2 result)) (car (nth 3 result)))
- (list (cdr (nth 2 result)) (cdr (nth 3 result))))
- (nthcdr 4 result)))))
+ (cons (floor high) (floor low))
+ ;; The middle 24 bits.
+ (setq middle (mod high #x1000000)
+ high (/ high #x1000000))
+ (cons (floor high)
+ (cons (floor middle) (floor low))))))
+ ;; Inodes can be incredible huge. We must
+ ;; hide this.
+ (error (tramp-get-inode ,vec)))))
+ ;; Set virtual device number.
+ (setcar (nthcdr 11 attr)
+ (tramp-get-device ,vec))
+ ;; Set SELinux context.
+ (when (stringp (nth 12 attr))
+ (tramp-set-file-property
+ ,vec ,localname "file-selinux-context"
+ (split-string (nth 12 attr) ":" 'omit)))
+ ;; Remove optional entries.
+ (setcdr (nthcdr 11 attr) nil)
+ attr)))))
+
+ ;; Return normalized result.
+ (append (tramp-compat-take 2 result)
+ (if (eq ,id-format 'string)
+ (list (car (nth 2 result)) (car (nth 3 result)))
+ (list (cdr (nth 2 result)) (cdr (nth 3 result))))
+ (nthcdr 4 result))))
(defun tramp-get-home-directory (vec &optional user)
"The remote home directory for connection VEC as local file name.
(catch 'result
(let ((default-directory temporary-file-directory))
(dolist (pid (list-system-processes))
- (when-let ((attributes (process-attributes pid))
- (comm (cdr (assoc 'comm attributes))))
- (and (string-equal (cdr (assoc 'user attributes)) (user-login-name))
- ;; The returned command name could be truncated to 15
- ;; characters. Therefore, we cannot check for `string-equal'.
- (string-prefix-p comm process-name)
- (throw 'result t))))))))
+ (and-let* ((attributes (process-attributes pid))
+ (comm (cdr (assoc 'comm attributes)))
+ ((string-equal
+ (cdr (assoc 'user attributes)) (user-login-name)))
+ ;; The returned command name could be truncated
+ ;; to 15 characters. Therefore, we cannot check
+ ;; for `string-equal'.
+ ((string-prefix-p comm process-name))
+ ((throw 'result t)))))))))
;; When calling "emacs -Q", `auth-source-search' won't be called. If
;; you want to debug exactly this case, call "emacs -Q --eval '(setq
;; adapt `default-directory'. (Bug#39389, Bug#39489)
(default-directory tramp-compat-temporary-file-directory)
(case-fold-search t)
- ;; In tramp-sh.el, we must use "password-vector" due to
- ;; multi-hop.
- (vec (tramp-get-connection-property
- proc "password-vector" (process-get proc 'tramp-vector)))
- (key (tramp-make-tramp-file-name vec 'noloc))
- (method (tramp-file-name-method vec))
- (user-domain (or (tramp-file-name-user-domain vec)
- (tramp-get-connection-property key "login-as")))
- (host-port (tramp-file-name-host-port vec))
+ ;; In tramp-sh.el, we must use "hop-vector" and "pw-vector"
+ ;; due to multi-hop.
+ (vec (process-get proc 'tramp-vector))
+ (hop-vec (tramp-get-connection-property proc "hop-vector" vec))
+ (pw-vec (tramp-get-connection-property proc "pw-vector" hop-vec))
+ (key (tramp-make-tramp-file-name pw-vec 'noloc))
+ (method (tramp-file-name-method pw-vec))
+ (user-domain (or (tramp-file-name-user-domain pw-vec)
+ (tramp-get-connection-property pw-vec "login-as")))
+ (host-port (tramp-file-name-host-port pw-vec))
(pw-prompt
(string-trim-left
(or prompt
(if (string-match-p "passphrase" (match-string 1))
(match-string 0)
(format "%s for %s " (capitalize (match-string 1)) key))))))
+ ;; If there is no user name, `:create' triggers to ask for.
+ ;; We suppress it.
+ (pw-spec (list :max 1 :user user-domain :host host-port :port method
+ :require (cons :secret (and user-domain '(:user)))
+ :create (and user-domain t)))
(auth-source-creation-prompts `((secret . ,pw-prompt)))
;; Use connection-local value.
(auth-sources (buffer-local-value 'auth-sources (process-buffer proc)))
auth-info auth-passwd tramp-dont-suspend-timers)
(unwind-protect
- ;; We cannot use `with-parsed-tramp-file-name', because it
- ;; expands the file name.
(or
(setq tramp-password-save-function nil)
- ;; See if auth-sources contains something useful.
+ ;; See if `auth-sources' contains something useful.
(ignore-errors
- (and auth-sources
- (tramp-get-connection-property vec "first-password-request")
- ;; Try with Tramp's current method. If there is no
- ;; user name, `:create' triggers to ask for. We
- ;; suppress it.
- (setq auth-info
- (car
- (auth-source-search
- :max 1 :user user-domain :host host-port :port method
- :require (cons :secret (and user-domain '(:user)))
- :create (and user-domain t)))
+ (and (tramp-get-connection-property hop-vec "first-password-request")
+ (setq auth-info (car (apply #'auth-source-search pw-spec))
tramp-password-save-function
(plist-get auth-info :save-function)
auth-passwd
;; Try the password cache.
(with-tramp-suspended-timers
- (setq auth-passwd (password-read pw-prompt key)
+ (setq auth-passwd
+ (password-read
+ pw-prompt (auth-source-format-cache-entry pw-spec))
tramp-password-save-function
- (lambda () (password-cache-add key auth-passwd)))
+ (when auth-source-do-cache
+ (lambda ()
+ (password-cache-add
+ (auth-source-format-cache-entry pw-spec) auth-passwd))))
auth-passwd))
;; Workaround. Prior Emacs 28.1, auth-source has saved empty
;; passwords. See discussion in Bug#50399.
(when (tramp-string-empty-or-nil-p auth-passwd)
(setq tramp-password-save-function nil))
- (tramp-set-connection-property vec "first-password-request" nil))))
+ ;; Remember the values.
+ (tramp-set-connection-property hop-vec "pw-spec" pw-spec)
+ (tramp-set-connection-property hop-vec "first-password-request" nil))))
(defun tramp-read-passwd-without-cache (proc &optional prompt)
"Read a password from user (compat function)."
(defun tramp-clear-passwd (vec)
"Clear password cache for connection related to VEC."
(declare (tramp-suppress-trace t))
- (let ((method (tramp-file-name-method vec))
- (user-domain (tramp-file-name-user-domain vec))
- (host-port (tramp-file-name-host-port vec))
- (hop (tramp-file-name-hop vec)))
- (when hop
- ;; Clear also the passwords of the hops.
- (tramp-clear-passwd (tramp-dissect-hop-name hop)))
- (auth-source-forget
- `(:max 1 ,(and user-domain :user) ,user-domain
- :host ,host-port :port ,method))
- (password-cache-remove (tramp-make-tramp-file-name vec 'noloc))))
+ (when-let* ((hop (cadr (reverse (tramp-compute-multi-hops vec)))))
+ ;; Clear also the passwords of the hops.
+ (tramp-clear-passwd hop))
+ (when-let* ((pw-spec (tramp-get-connection-property vec "pw-spec")))
+ (auth-source-forget pw-spec)))
(defun tramp-time-diff (t1 t2)
"Return the difference between the two times, in seconds.
;;
;; * Implement user and host name completion for multi-hops. Some
;; methods in tramp-container.el have it already.
+;;
+;; * Make it configurable, which environment variables are set in
+;; direct async processes.
+;;
+;; * Pass working dir for direct async processes, for example for
+;; container methods.
;;; tramp.el ends here
;; Maintainer: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;; Package: tramp
-;; Version: 2.7.1.30.1
+;; Version: 2.7.3-pre
;; Package-Requires: ((emacs "27.1"))
;; Package-Type: multi
;; URL: https://www.gnu.org/software/tramp/
;; ./configure" to change them.
;;;###tramp-autoload
-(defconst tramp-version "2.7.1.30.1"
+(defconst tramp-version "2.7.3-pre"
"This version of Tramp.")
;;;###tramp-autoload
(defconst tramp-bug-report-address "tramp-devel@gnu.org"
"Email address to send bug reports to.")
-;;;###tramp-autoload
(defconst tramp-repository-branch
(ignore-errors
;; Suppress message from `emacs-repository-get-branch'. We must
(emacs-repository-get-branch dir))))
"The repository branch of the Tramp sources.")
-;;;###tramp-autoload
(defconst tramp-repository-version
(ignore-errors
;; Suppress message from `emacs-repository-get-version'. We must
;; Check for Emacs version.
(let ((x (if (not (string-version-lessp emacs-version "27.1"))
"ok"
- (format "Tramp 2.7.1.30.1 is not fit for %s"
+ (format "Tramp 2.7.3-pre is not fit for %s"
(replace-regexp-in-string "\n" "" (emacs-version))))))
(unless (string-equal "ok" x) (error "%s" x)))
(tramp-dissect-file-name ert-remote-temporary-file-directory))
"The used `tramp-file-name' structure.")
-(setq auth-source-save-behavior nil
+(setq auth-source-cache-expiry nil
+ auth-source-save-behavior nil
+ ert-batch-backtrace-right-margin nil
password-cache-expiry nil
remote-file-name-inhibit-cache nil
tramp-allow-unsafe-temporary-files t
tramp-copy-size-limit nil
tramp-error-show-message-timeout nil
tramp-persistency-file-name nil
- tramp-verbose 0)
+ tramp-verbose 0
+ vc-handled-backends (unless noninteractive vc-handled-backends))
(defvar tramp--test-enabled-checked nil
"Cached result of `tramp--test-enabled'.
(when (cdr tramp--test-enabled-checked)
;; Remove old test files.
(dolist (dir `(,temporary-file-directory
+ ,tramp-compat-temporary-file-directory
,ert-remote-temporary-file-directory))
(dolist (file (directory-files dir 'full (rx bos (? ".#") "tramp-test")))
(ignore-errors
(delete-file file)))))
;; Cleanup connection.
(ignore-errors
- (tramp-cleanup-connection tramp-test-vec nil 'keep-password)))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)))
;; Return result.
(cdr tramp--test-enabled-checked))
(when (assoc m tramp-methods)
(let (tramp-connection-properties tramp-default-proxies-alist)
(ignore-errors
- (tramp-cleanup-connection tramp-test-vec nil 'keep-password))
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password))
;; Single hop. The host name must match `tramp-local-host-regexp'.
(should-error
(find-file (format "/%s:foo:" m))
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
- (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
+ (tmp-name3 (tramp--test-make-temp-name 'local quoted))
+ (tmp-name4
+ (file-name-nondirectory (tramp--test-make-temp-name 'local quoted))))
(dolist (source-target
`(;; Copy on remote side.
(,tmp-name1 . ,tmp-name2)
(,tmp-name1 . ,tmp-name3)
;; Copy from local side to remote side.
(,tmp-name3 . ,tmp-name1)))
- (let ((source (car source-target))
- (target (cdr source-target)))
+ (let* ((source (car source-target))
+ (source-link
+ (expand-file-name tmp-name4 (file-name-directory source)))
+ (target (cdr source-target))
+ (target-link
+ (expand-file-name tmp-name4 (file-name-directory target))))
;; Copy simple file.
(unwind-protect
(ignore-errors (delete-file source))
(ignore-errors (delete-file target)))
+ ;; Copy symlinked file.
+ (unwind-protect
+ (tramp--test-ignore-make-symbolic-link-error
+ (write-region "foo" nil source-link)
+ (should (file-exists-p source-link))
+ (make-symbolic-link tmp-name4 source)
+ (should (file-exists-p source))
+ (should (string-equal (file-symlink-p source) tmp-name4))
+ (copy-file source target)
+ ;; Some backends like tramp-gvfs.el do not create the
+ ;; link on the target.
+ (when (file-symlink-p target)
+ (should (string-equal (file-symlink-p target) tmp-name4))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file source))
+ (ignore-errors (delete-file source-link))
+ (ignore-errors (delete-file target))
+ (ignore-errors (delete-file target-link)))
+
;; Copy file to directory.
(unwind-protect
;; This doesn't work on FTP.
(dolist (quoted (if (tramp--test-expensive-test-p) '(nil t) '(nil)))
(let ((tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (tramp--test-make-temp-name nil quoted))
- (tmp-name3 (tramp--test-make-temp-name 'local quoted)))
+ (tmp-name3 (tramp--test-make-temp-name 'local quoted))
+ (tmp-name4
+ (file-name-nondirectory (tramp--test-make-temp-name 'local quoted))))
(dolist (source-target
`(;; Rename on remote side.
(,tmp-name1 . ,tmp-name2)
(,tmp-name1 . ,tmp-name3)
;; Rename from local side to remote side.
(,tmp-name3 . ,tmp-name1)))
- (let ((source (car source-target))
- (target (cdr source-target)))
+ (let* ((source (car source-target))
+ (source-link
+ (expand-file-name tmp-name4 (file-name-directory source)))
+ (target (cdr source-target))
+ (target-link
+ (expand-file-name tmp-name4 (file-name-directory target))))
;; Rename simple file.
(unwind-protect
(ignore-errors (delete-file source))
(ignore-errors (delete-file target)))
+ ;; Rename symlinked file.
+ (unwind-protect
+ (tramp--test-ignore-make-symbolic-link-error
+ (write-region "foo" nil source-link)
+ (should (file-exists-p source-link))
+ (make-symbolic-link tmp-name4 source)
+ (should (file-exists-p source))
+ (should (string-equal (file-symlink-p source) tmp-name4))
+ (rename-file source target)
+ (should-not (file-exists-p source))
+ ;; Some backends like tramp-gvfs.el do not create the
+ ;; link on the target.
+ (when (file-symlink-p target)
+ (should (string-equal (file-symlink-p target) tmp-name4))))
+
+ ;; Cleanup.
+ (ignore-errors (delete-file source))
+ (ignore-errors (delete-file source-link))
+ (ignore-errors (delete-file target))
+ (ignore-errors (delete-file target-link)))
+
;; Rename file to directory.
(unwind-protect
(progn
(should (stringp (file-attribute-user-id attr)))
(should (stringp (file-attribute-group-id attr)))
+ ;; Symbolic links.
(tramp--test-ignore-make-symbolic-link-error
(should-error
(access-file tmp-name2 "error")
(if quoted #'file-name-quote #'identity)
(file-attribute-type attr))
(file-remote-p (file-truename tmp-name1) 'localname)))
- (delete-file tmp-name2))
+ (delete-file tmp-name2)
+
+ ;; A non-existent or cyclic link target makes the file
+ ;; unaccessible.
+ (dolist (target
+ `("does-not-exist" ,(file-name-nondirectory tmp-name2)))
+ (make-symbolic-link target tmp-name2)
+ (should (file-symlink-p tmp-name2))
+ (should-not (file-exists-p tmp-name2))
+ (should-not (file-directory-p tmp-name2))
+ (should-error
+ (access-file tmp-name2 "error")
+ :type
+ (if (string-equal target "does-not-exist")
+ 'file-missing 'file-error))
+ ;; `file-ownership-preserved-p' should return t for
+ ;; symlinked files to a non-existing or cyclic target.
+ (when test-file-ownership-preserved-p
+ (should (file-ownership-preserved-p tmp-name2 'group)))
+ (delete-file tmp-name2)))
;; Check, that "//" in symlinks are handled properly.
(with-temp-buffer
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-stat tramp-test-vec))
- (if-let ((default-directory ert-remote-temporary-file-directory)
- (ert-test (ert-get-test ',test))
- (result (ert-test-most-recent-result ert-test))
- (tramp-connection-properties
- (cons '(nil "perl" nil)
- tramp-connection-properties)))
+ (if-let* ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (result (ert-test-most-recent-result ert-test))
+ (tramp-connection-properties
+ (cons '(nil "perl" nil)
+ tramp-connection-properties)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
(skip-unless (tramp-get-remote-perl tramp-test-vec))
- (if-let ((default-directory ert-remote-temporary-file-directory)
- (ert-test (ert-get-test ',test))
- (result (ert-test-most-recent-result ert-test))
- (tramp-connection-properties
- (append
- '((nil "stat" nil)
- ;; See `tramp-sh-handle-file-truename'.
- (nil "readlink" nil)
- ;; See `tramp-sh-handle-get-remote-*'.
- (nil "id" nil))
- tramp-connection-properties)))
+ (if-let* ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (result (ert-test-most-recent-result ert-test))
+ (tramp-connection-properties
+ (append
+ '((nil "stat" nil)
+ ;; See `tramp-sh-handle-file-truename'.
+ (nil "readlink" nil)
+ ;; See `tramp-sh-handle-get-remote-*'.
+ (nil "id" nil))
+ tramp-connection-properties)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(tramp--test-set-ert-test-documentation ',test "ls")
(skip-unless (tramp--test-enabled))
(skip-unless (tramp--test-sh-p))
- (if-let ((default-directory ert-remote-temporary-file-directory)
- (ert-test (ert-get-test ',test))
- (result (ert-test-most-recent-result ert-test))
- (tramp-connection-properties
- (append
- '((nil "perl" nil)
- (nil "stat" nil)
- ;; See `tramp-sh-handle-file-truename'.
- (nil "readlink" nil))
- tramp-connection-properties)))
+ (if-let* ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (result (ert-test-most-recent-result ert-test))
+ (tramp-connection-properties
+ (append
+ '((nil "perl" nil)
+ (nil "stat" nil)
+ ;; See `tramp-sh-handle-file-truename'.
+ (nil "readlink" nil))
+ tramp-connection-properties)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(funcall (ert-test-body ert-test)))
(skip-unless (tramp--test-enabled))
(skip-unless
(or (tramp--test-adb-p) (tramp--test-sh-p) (tramp--test-sudoedit-p)))
- (if-let ((default-directory ert-remote-temporary-file-directory)
- (ert-test (ert-get-test ',test))
- (result (ert-test-most-recent-result ert-test)))
+ (if-let* ((default-directory ert-remote-temporary-file-directory)
+ (ert-test (ert-get-test ',test))
+ (result (ert-test-most-recent-result ert-test)))
(progn
(skip-unless (< (ert-test-result-duration result) 300))
(let (tramp-use-file-attributes)
(should (file-symlink-p tmp-name1))
(should (file-symlink-p tmp-name2))
(should-not (file-regular-p tmp-name1))
- (should-not (file-regular-p tmp-name2))
- (should-error
- (file-truename tmp-name1)
- :type 'file-error)
- (should-error
- (file-truename tmp-name2)
- :type 'file-error))))
+ (should-not (file-regular-p tmp-name2)))))
;; Cleanup.
(ignore-errors
(ert-deftest tramp-test26-interactive-file-name-completion ()
"Check interactive completion with different `completion-styles'."
;; Method, user and host name in completion mode.
- (tramp-cleanup-connection tramp-test-vec nil 'keep-password)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
(let ((method (file-remote-p ert-remote-temporary-file-directory 'method))
(user (file-remote-p ert-remote-temporary-file-directory 'user))
;; (delete-file tmp-name)))
;; Check remote and local STDERR.
- (dolist (local '(nil t))
- (setq tmp-name (tramp--test-make-temp-name local quoted))
- (should-not
- (zerop
- (process-file "cat" nil `(t ,tmp-name) nil "/does-not-exist")))
- (with-temp-buffer
- (insert-file-contents tmp-name)
- (should
- (string-match-p
- (rx "cat:" (* nonl) " No such file or directory")
- (buffer-string)))
- (should-not (get-buffer-window (current-buffer) t))
- (delete-file tmp-name))))
+ (unless (tramp--test-sshfs-p)
+ (dolist (local '(nil t))
+ (setq tmp-name (tramp--test-make-temp-name local quoted))
+ (should-not
+ (zerop
+ (process-file "cat" nil `(t ,tmp-name) nil "/does-not-exist")))
+ (with-temp-buffer
+ (insert-file-contents tmp-name)
+ (should
+ (string-match-p
+ (rx "cat:" (* nonl) " No such file or directory")
+ (buffer-string)))
+ (should-not (get-buffer-window (current-buffer) t))
+ (delete-file tmp-name)))))
;; Cleanup.
(ignore-errors (kill-buffer buffer))
"Timeout handler, reporting a failed test."
(interactive)
(tramp--test-message "proc: %s" (get-buffer-process (current-buffer)))
- (when-let ((proc (get-buffer-process (current-buffer)))
- ((processp proc)))
+ (when-let* ((proc (get-buffer-process (current-buffer)))
+ ((processp proc)))
(tramp--test-message "cmd: %s" (process-command proc)))
(tramp--test-message "buf: %s\n%s\n---" (current-buffer) (buffer-string))
(ert-fail (format "`%s' timed out" (ert-test-name (ert-running-test)))))
direct-async-process-profile)
connection-local-criteria-alist)))
(skip-unless (tramp-direct-async-process-p))
+ (when-let* ((result (ert-test-most-recent-result ert-test)))
+ (skip-unless (< (ert-test-result-duration result) 300)))
;; We do expect an established connection already,
;; `file-truename' does it by side-effect. Suppress
;; `tramp--test-enabled', in order to keep the connection.
(setq command '("sleep" "100")
proc (apply #'start-file-process "test" nil command))
(while (accept-process-output proc 0))
- (when-let ((pid (process-get proc 'remote-pid))
- (attributes (process-attributes pid)))
+ (when-let* ((pid (process-get proc 'remote-pid))
+ (attributes (process-attributes pid)))
;; (tramp--test-message "%s" attributes)
(should (equal (cdr (assq 'comm attributes)) (car command)))
(should (equal (cdr (assq 'args attributes))
;; `memory-info' is supported since Emacs 29.1.
(skip-unless (tramp--test-emacs29-p))
- (when-let ((default-directory ert-remote-temporary-file-directory)
- (mi (memory-info)))
+ (when-let* ((default-directory ert-remote-temporary-file-directory)
+ (mi (memory-info)))
(should (consp mi))
(should (tramp-compat-length= mi 4))
(dotimes (i (length mi))
;; Test `async-shell-command-width'.
(when (and (tramp--test-asynchronous-processes-p) (tramp--test-sh-p))
- (let* ((async-shell-command-width 1024)
+ (let* (;; Since Fedora 41, this seems to be the upper limit. Used
+ ;; to be 1024 before.
+ (async-shell-command-width 512)
(default-directory ert-remote-temporary-file-directory)
(cols (ignore-errors
(read (tramp--test-shell-command-to-string-asynchronously
(tmp-name1 (tramp--test-make-temp-name nil quoted))
(tmp-name2 (expand-file-name "foo" tmp-name1))
(tramp-remote-process-environment tramp-remote-process-environment)
+ ;; Suppress nasty messages.
(inhibit-message t)
(vc-handled-backends
(cond
(tramp-cleanup-connection
tramp-test-vec 'keep-debug 'keep-password)
'(Bzr))
- (t nil)))
- ;; Suppress nasty messages.
- (inhibit-message t))
+ (t nil))))
(skip-unless vc-handled-backends)
(unless quoted (tramp--test-message "%s" vc-handled-backends))
(should-not (with-no-warnings (file-locked-p tmp-name1)))
;; `kill-buffer' removes the lock.
- (with-no-warnings (lock-file tmp-name1))
- (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
- (with-temp-buffer
- (set-visited-file-name tmp-name1)
- (insert "foo")
- (should (buffer-modified-p))
- (cl-letf (((symbol-function #'read-from-minibuffer)
- (lambda (&rest _args) "yes")))
- (kill-buffer)))
- (should-not (with-no-warnings (file-locked-p tmp-name1)))
+ ;; `kill-buffer--possibly-save' exists since Emacs 29.1.
+ (when (fboundp 'kill-buffer--possibly-save)
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+ (with-temp-buffer
+ (set-visited-file-name tmp-name1)
+ (insert "foo")
+ (should (buffer-modified-p))
+ ;; Modifying `read-from-minibuffer' doesn't work on MS Windows.
+ (cl-letf (((symbol-function #'kill-buffer--possibly-save)
+ #'tramp-compat-always))
+ (kill-buffer)))
+ (should-not (with-no-warnings (file-locked-p tmp-name1))))
;; `kill-buffer' should not remove the lock when the
;; connection is broken. See Bug#61663.
- (with-no-warnings (lock-file tmp-name1))
- (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
- (with-temp-buffer
- (set-visited-file-name tmp-name1)
- (insert "foo")
- (should (buffer-modified-p))
- (tramp-cleanup-connection
- tramp-test-vec 'keep-debug 'keep-password)
- (cl-letf (((symbol-function #'read-from-minibuffer)
- (lambda (&rest _args) "yes")))
- (kill-buffer)))
- ;; A new connection changes process id, and also the
- ;; lock file contents. But it still exists.
- (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (should (stringp (with-no-warnings (file-locked-p tmp-name1))))
+ ;; `kill-buffer--possibly-save' exists since Emacs 29.1.
+ (when (fboundp 'kill-buffer--possibly-save)
+ (with-no-warnings (lock-file tmp-name1))
+ (should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
+ (with-temp-buffer
+ (set-visited-file-name tmp-name1)
+ (insert "foo")
+ (should (buffer-modified-p))
+ (tramp-cleanup-connection
+ tramp-test-vec 'keep-debug 'keep-password)
+ ;; Modifying `read-from-minibuffer' doesn't work on MS Windows.
+ (cl-letf (((symbol-function #'kill-buffer--possibly-save)
+ #'tramp-compat-always))
+ (kill-buffer)))
+ ;; A new connection changes process id, and also the
+ ;; lock file contents. But it still exists.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ (should (stringp (with-no-warnings (file-locked-p tmp-name1)))))
;; When `remote-file-name-inhibit-locks' is set, nothing happens.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
;; Steal the file lock.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?s)))
+ ;; Modifying `read-char' doesn't work on MS Windows.
+ (cl-letf (((symbol-function #'ask-user-about-lock)
+ #'tramp-compat-always))
(with-no-warnings (lock-file tmp-name1)))
(should (eq (with-no-warnings (file-locked-p tmp-name1)) t))
;; Ignore the file lock.
(tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?p)))
+ ;; Modifying `read-char' doesn't work on MS Windows.
+ (cl-letf (((symbol-function #'ask-user-about-lock) #'ignore))
(with-no-warnings (lock-file tmp-name1)))
(should (stringp (with-no-warnings (file-locked-p tmp-name1))))
- ;; Quit the file lock machinery.
- (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
- (cl-letf (((symbol-function #'read-char) (lambda (&rest _args) ?q)))
- (with-no-warnings
+ ;; Quit the file lock machinery. There are problems with
+ ;; "sftp" and "podman", so we test on Emacs 29.1 only.
+ (when (tramp--test-emacs29-p )
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug 'keep-password)
+ ;; Modifying `read-char' doesn't work on MS Windows.
+ (cl-letf (((symbol-function #'ask-user-about-lock)
+ (lambda (&rest args)
+ (signal 'file-locked args))))
+ (with-no-warnings
+ (should-error
+ (lock-file tmp-name1)
+ :type 'file-locked))
+ ;; The same for `write-region'.
(should-error
- (lock-file tmp-name1)
- :type 'file-locked))
- ;; The same for `write-region'.
- (should-error
- (write-region "foo" nil tmp-name1)
- :type 'file-locked)
- (should-error
- (write-region "foo" nil tmp-name1 nil nil tmp-name1)
- :type 'file-locked)
- ;; The same for `set-visited-file-name'.
- (with-temp-buffer
- (should-error
- (set-visited-file-name tmp-name1)
- :type 'file-locked)))
+ (write-region "foo" nil tmp-name1)
+ :type 'file-locked)
+ (should-error
+ (write-region "foo" nil tmp-name1 nil nil tmp-name1)
+ :type 'file-locked)
+ ;; The same for `set-visited-file-name'.
+ (with-temp-buffer
+ (should-error
+ (set-visited-file-name tmp-name1)
+ :type 'file-locked))))
(should (stringp (with-no-warnings (file-locked-p tmp-name1)))))
;; Cleanup.
(if quoted #'file-name-quote #'identity)
(file-attribute-type (file-attributes file3)))
(file-remote-p (file-truename file1) 'localname)))
- ;; Check file contents.
- (with-temp-buffer
- (insert-file-contents file3)
- (should (string-equal (buffer-string) elt)))
(delete-file file3))))
;; Check file names.
(setq buffer (dired-noselect tmp-name1 "--dired -al"))
(goto-char (point-min))
(while (not (eobp))
- (when-let ((name (dired-get-filename 'no-dir 'no-error)))
+ (when-let* ((name (dired-get-filename 'no-dir 'no-error)))
(unless
(string-match-p name directory-files-no-dot-files-regexp)
(should (member name files))))
;; to U+1FFFF).
"🌈🍒👋")
- (when (tramp--test-expensive-test-p)
+ (when (and (tramp--test-expensive-test-p) (not (tramp--test-windows-nt-p)))
(delete-dups
(mapcar
;; Use all available language specific snippets.
"Check that `file-system-info' returns proper values."
(skip-unless (tramp--test-enabled))
- (when-let ((fsi (file-system-info ert-remote-temporary-file-directory)))
+ (when-let* ((fsi (file-system-info ert-remote-temporary-file-directory)))
(should (consp fsi))
(should (tramp-compat-length= fsi 3))
(dotimes (i (length fsi))
(should (or (stringp (tramp-get-remote-gid v 'string))
(null (tramp-get-remote-gid v 'string))))
- (when-let ((groups (tramp-get-remote-groups v 'integer)))
+ (when-let* ((groups (tramp-get-remote-groups v 'integer)))
(should (consp groups))
(dolist (group groups) (should (integerp group))))
- (when-let ((groups (tramp-get-remote-groups v 'string)))
+ (when-let* ((groups (tramp-get-remote-groups v 'string)))
(should (consp groups))
(dolist (group groups) (should (stringp group)))))))
buf)
(while buffers
(setq buf (seq-random-elt buffers))
- (if-let ((proc (get-buffer-process buf))
- (file (process-get proc 'foo))
- (count (process-get proc 'bar)))
+ (if-let* ((proc (get-buffer-process buf))
+ (file (process-get proc 'foo))
+ (count (process-get proc 'bar)))
(progn
(tramp--test-message
"Start action %d %s %s" count buf (current-time-string))
(let ((pass "secret")
(mock-entry (copy-tree (assoc "mock" tramp-methods)))
- mocked-input tramp-methods)
+ mocked-input tramp-methods auth-sources)
;; We must mock `read-string', in order to avoid interactive
;; arguments.
(cl-letf* (((symbol-function #'read-string)
"machine %s port mock password %s"
(file-remote-p ert-remote-temporary-file-directory 'host) pass)
(let ((auth-sources `(,netrc-file)))
- (should (file-exists-p ert-remote-temporary-file-directory)))))))))
+ (should (file-exists-p ert-remote-temporary-file-directory))))))
+
+ ;; Checking session-timeout.
+ (with-no-warnings (when (symbol-plist 'ert-with-temp-file)
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ (let ((tramp-connection-properties
+ (cons '(nil "session-timeout" 1)
+ tramp-connection-properties)))
+ (setq mocked-input nil)
+ (auth-source-forget-all-cached)
+ (ert-with-temp-file netrc-file
+ :prefix "tramp-test" :suffix ""
+ :text (format
+ "machine %s port mock password %s"
+ (file-remote-p ert-remote-temporary-file-directory 'host)
+ pass)
+ (let ((auth-sources `(,netrc-file)))
+ (should (file-exists-p ert-remote-temporary-file-directory))))
+ ;; Session established, password cached.
+ (should
+ (password-in-cache-p
+ (auth-source-format-cache-entry
+ (tramp-get-connection-property tramp-test-vec "pw-spec"))))
+ ;; We want to see the timeout message.
+ (tramp--test-instrument-test-case 3
+ (sleep-for 2))
+ ;; Session canceled, no password in cache.
+ (should-not
+ (password-in-cache-p
+ (auth-source-format-cache-entry
+ (tramp-get-connection-property tramp-test-vec "pw-spec"))))))))))
(ert-deftest tramp-test47-read-otp-password ()
"Check Tramp one-time password handling."
(should-error
(file-exists-p ert-remote-temporary-file-directory)))))))))
+(ert-deftest tramp-test47-read-fingerprint ()
+ "Check Tramp fingerprint handling."
+ :tags '(:expensive-test)
+ (skip-unless (tramp--test-mock-p))
+
+ (let (;; Suppress "exec".
+ (tramp-restricted-shell-hosts-alist `(,tramp-system-name)))
+
+ ;; Reading fingerprint works.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ (let ((tramp-connection-properties
+ `((nil "login-args"
+ (("-c")
+ (,(tramp-shell-quote-argument
+ "echo Place your finger on the fingerprint reader"))
+ (";") ("sleep" "1")
+ (";") ("sh" "-i"))))))
+ (should (file-exists-p ert-remote-temporary-file-directory)))
+
+ ;; Falling back after a timeout works.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ (let ((tramp-connection-properties
+ `((nil "login-args"
+ (("-c")
+ (,(tramp-shell-quote-argument
+ "echo Place your finger on the fingerprint reader"))
+ (";") ("sleep" "1")
+ (";") ("echo" "Failed to match fingerprint")
+ (";") ("sh" "-i"))))))
+ (should (file-exists-p ert-remote-temporary-file-directory)))
+
+ ;; Interrupting the fingerprint handshaking works.
+ (tramp-cleanup-connection tramp-test-vec 'keep-debug)
+ (let ((tramp-connection-properties
+ `((nil "login-args"
+ (("-c")
+ (,(tramp-shell-quote-argument
+ "echo Place your finger on the fingerprint reader"))
+ (";") ("sleep" "1")
+ (";") ("sh" "-i")))))
+ tramp-use-fingerprint)
+ (should (file-exists-p ert-remote-temporary-file-directory)))))
+
;; This test is inspired by Bug#29163.
(ert-deftest tramp-test48-auto-load ()
"Check that Tramp autoloads properly."
;; * file-equal-p (partly done in `tramp-test21-file-links')
;; * file-in-directory-p
;; * file-name-case-insensitive-p
-;; * memory-info
;; * tramp-get-home-directory
;; * tramp-set-file-uid-gid
projects / emacs.git / commitdiff